WinPrinterContext.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Fri, 07 Jun 2019 19:57:30 +0100
branchjv
changeset 4278 8cc5f9eafef8
parent 4132 7e5528572373
permissions -rw-r--r--
Set view's UUID when building a view from spec
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4132
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
     1
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
     2
 COPYRIGHT (c) 2006 by eXept Software AG
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
     3
 COPYRIGHT (c) 2015 Jan Vrany
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
     4
	      All Rights Reserved
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
     5
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
     6
 This software is furnished under a license and may be used
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
     7
 only in accordance with the terms of that license and with the
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
     8
 inclusion of the above copyright notice.   This software may not
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
     9
 be provided or otherwise made available to, or used by, any
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    10
 other person.  No title to or ownership of the software is
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    11
 hereby transferred.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    12
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    13
"{ Package: 'stx:libview2' }"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    14
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    15
"{ NameSpace: Smalltalk }"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    16
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    17
PrinterContext subclass:#WinPrinterContext
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    18
	instanceVariableNames:'deviceFonts hatch supportsColor title'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    19
	classVariableNames:'PostScriptBlackWhite'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    20
	poolDictionaries:''
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    21
	category:'Interface-Printing'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    22
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    23
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    24
WinPrinterContext subclass:#WinPrinterGraphicContext
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    25
	instanceVariableNames:'fontScale printPageNumbers pageNumberFormat pageCounter
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    26
		needsEndOfPage titleFont width height'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    27
	classVariableNames:''
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    28
	poolDictionaries:''
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    29
	privateIn:WinPrinterContext
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    30
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    31
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    32
!WinPrinterContext primitiveDefinitions!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    33
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    34
#undef INT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    35
#define INT WIN_INT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    36
#undef Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    37
#define Array WIN_Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    38
#undef Number
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    39
#define Number WIN_Number
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    40
#undef Method
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    41
#define Method WIN_Method
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    42
#undef Point
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    43
#define Point WIN_Point
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    44
#undef Rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    45
/* #define Rectangle WIN_Rectangle */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    46
#undef True
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    47
#define True WIN_True
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    48
#undef False
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    49
#define False WIN_False
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    50
#undef Block
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    51
#define Block WIN_Block
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    52
#undef Context
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    53
#define Context WIN_Context
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    54
#undef Date
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    55
#define Date WIN_Date
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    56
#undef Time
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    57
#define Time WIN_Time
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    58
#undef Delay
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    59
#define Delay WIN_Delay
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    60
#undef Signal
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    61
#define Signal WIN_Signal
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    62
#undef Set
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    63
#define Set WIN_Set
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    64
#undef Process
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    65
#define Process WIN_Process
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    66
#undef Processor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    67
#define Processor WIN_Processor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    68
#undef Message
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    69
#define Message WIN_Message
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    70
#undef String
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    71
#define String WIN_String
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    72
#undef Character
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    73
#define Character WIN_Character
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    74
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    75
#include <stdio.h>
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    76
#include <errno.h>
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    77
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    78
#ifdef __BORLANDC__
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    79
# define NOATOM
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    80
# define NOGDICAPMASKS
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    81
# define NOMETAFILE
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    82
# define NOMINMAX
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    83
# define NOOPENFILE
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    84
# define NOSOUND
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    85
# define NOWH
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    86
# define NOCOMM
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    87
# define NOKANJI
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    88
# define NOCRYPT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    89
# define NOMCX
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    90
# define WIN32_LEAN_AND_MEAN
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    91
# include <windows.h>
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    92
# include <shellapi.h>
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    93
# include <sys\timeb.h>
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    94
# include <dir.h>
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    95
#else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    96
# define _USERENTRY /**/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    97
# define NOATOM
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    98
# define NOGDICAPMASKS
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
    99
# define NOMETAFILE
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   100
# define NOMINMAX
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   101
# define NOOPENFILE
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   102
# define NOSOUND
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   103
# define NOWH
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   104
# define NOCOMM
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   105
# define NOKANJI
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   106
# define NOCRYPT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   107
# define NOMCX
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   108
# define WIN32_LEAN_AND_MEAN
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   109
# include <windows.h>
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   110
# include <sys\timeb.h>
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   111
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   112
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   113
#include <process.h>
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   114
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   115
#ifdef __DEF_Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   116
# undef Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   117
# define Array __DEF_Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   118
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   119
#ifdef __DEF_Number
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   120
# undef Number
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   121
# define Number __DEF_Number
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   122
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   123
#ifdef __DEF_Method
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   124
# undef Method
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   125
# define Method __DEF_Method
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   126
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   127
#ifdef __DEF_Point
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   128
# undef Point
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   129
# define Point __DEF_Point
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   130
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   131
#ifdef __DEF_Rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   132
# undef Rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   133
# define Rectangle __DEF_Rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   134
#else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   135
# undef Rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   136
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   137
#ifdef __DEF_Block
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   138
# undef Block
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   139
# define Block __DEF_Block
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   140
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   141
#ifdef __DEF_Context
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   142
# undef Context
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   143
# define Context __DEF_Context
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   144
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   145
#ifdef __DEF_Date
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   146
# undef Date
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   147
# define Date __DEF_Date
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   148
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   149
#ifdef __DEF_Time
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   150
# undef Time
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   151
# define Time __DEF_Time
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   152
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   153
# ifdef __DEF_Set
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   154
#  undef Set
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   155
#  define Set __DEF_Set
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   156
# endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   157
# ifdef __DEF_Signal
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   158
#  undef Signal
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   159
#  define Signal __DEF_Signal
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   160
# endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   161
# ifdef __DEF_Delay
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   162
#  undef Delay
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   163
#  define Delay __DEF_Delay
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   164
# endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   165
# ifdef __DEF_Process
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   166
#  undef Process
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   167
#  define Process __DEF_Process
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   168
# endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   169
# ifdef __DEF_Processor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   170
#  undef Processor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   171
#  define Processor __DEF_Processor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   172
# endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   173
# ifdef __DEF_Message
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   174
#  undef Message
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   175
#  define Message __DEF_Message
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   176
# endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   177
# ifdef __DEF_String
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   178
#  undef String
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   179
#  define String __DEF_String
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   180
# endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   181
# ifdef __DEF_Character
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   182
#  undef Character
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   183
#  define Character __DEF_Character
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   184
# endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   185
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   186
#undef INT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   187
#define INT STX_INT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   188
#undef UINT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   189
#define UINT STX_UINT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   190
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   191
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   192
 * some defines - tired of typing ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   193
 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   194
#define _HANDLEVal(o)        (HANDLE)(__MKCP(o))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   195
#define _HBITMAPVAL(o)       (HBITMAP)(__MKCP(o))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   196
#define _HWNDVal(o)          (HWND)(__MKCP(o))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   197
#define _HPALETTEVal(o)      (HPALETTE)(__MKCP(o))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   198
#define _HCURSORVal(o)       (HCURSOR)(__MKCP(o))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   199
#define _HGDIOBJVal(o)       (HGDIOBJ)(__MKCP(o))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   200
#define _LOGPALETTEVal(o)    (LOGPALETTE *)(__MKCP(o))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   201
#define _COLORREFVal(o)      (COLORREF)(__MKCP(o))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   202
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   203
#define WIDECHAR unsigned short
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   204
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   205
#define WIN32PADDING 32
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   206
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   207
#ifdef DEBUG
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   208
# define DPRINTF(x)              /* printf  x */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   209
# define DFPRINTF(x)             /* fprintf x */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   210
#else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   211
# define DPRINTF(x)              /* */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   212
# define DFPRINTF(x)             /* */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   213
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   214
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   215
typedef int (*intf)(int);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   216
typedef INT (*INTF)(INT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   217
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   218
/* PS_JOIN_MASK is missing from the mingw32 headers */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   219
#ifndef PS_JOIN_MASK
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   220
# define PS_JOIN_MASK (PS_JOIN_BEVEL|PS_JOIN_MITER|PS_JOIN_ROUND)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   221
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   222
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   223
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   224
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   225
!WinPrinterContext class methodsFor:'documentation'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   226
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   227
copyright
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   228
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   229
 COPYRIGHT (c) 2006 by eXept Software AG
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   230
 COPYRIGHT (c) 2015 Jan Vrany
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   231
	      All Rights Reserved
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   232
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   233
 This software is furnished under a license and may be used
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   234
 only in accordance with the terms of that license and with the
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   235
 inclusion of the above copyright notice.   This software may not
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   236
 be provided or otherwise made available to, or used by, any
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   237
 other person.  No title to or ownership of the software is
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   238
 hereby transferred.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   239
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   240
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   241
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   242
documentation
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   243
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   244
    I am the mediator between the smalltalk printing protocol
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   245
    (which is the same as the graphics drawing protocol) and the
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   246
    windows printer.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   247
    When you open a printer, you will typically talk to me.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   248
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   249
    [author:]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   250
	Felix Madrid (fm@exept.de)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   251
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   252
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   253
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   254
!WinPrinterContext class methodsFor:'instance creation'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   255
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   256
fromPrinterInfo: aPrinterInfo
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   257
    | printerContext printerDevice hDC|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   258
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   259
    hDC := aPrinterInfo createDC.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   260
    hDC = 0 ifTrue: [ ^self error: 'Error while opening printer.' ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   261
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   262
    printerContext := self new.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   263
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   264
    printerDevice := printerContext.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   265
"/    printerDevice := WinPrinter on: aPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   266
"/    printerDevice printerDC:hDC.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   267
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   268
    printerContext printerInfo: aPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   269
    printerContext setDevice:printerDevice id:nil gcId:hDC.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   270
    printerContext initExtent.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   271
    ^printerContext
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   272
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   273
    "Created: / 03-08-2006 / 12:53:52 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   274
    "Modified: / 04-08-2006 / 12:55:01 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   275
    "Modified: / 16-04-2007 / 12:36:26 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   276
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   277
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   278
newPrinter
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   279
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   280
    | printer printerInfo|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   281
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   282
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   283
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   284
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   285
    ^ printer
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   286
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   287
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   288
openGraphicContext
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   289
    ^ self openGraphicContextWithoutDialog:false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   290
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   291
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   292
openGraphicContextWithoutDialog:withoutDialog
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   293
    ^ self openGraphicContextWithoutDialog:withoutDialog jobName:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   294
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   295
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   296
openGraphicContextWithoutDialog:withoutDialog jobName:jobName
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   297
    |printerInfo gc|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   298
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   299
    printerInfo := PrintingDialog getPrinterInfoWithoutDialog:withoutDialog.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   300
    printerInfo isNil ifTrue:[^ nil].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   301
    gc := WinPrinterGraphicContext fromPrinterInfo:printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   302
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   303
    gc notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   304
	gc startPrintJob:jobName
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   305
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   306
    ^ gc
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   307
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   308
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   309
!WinPrinterContext class methodsFor:'accessing'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   310
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   311
getPrinterInformation:printerNameString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   312
    " Answer the printer information for the printer named printerNameString.  If no name is specified,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   313
      answer the information for the default printer."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   314
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   315
    |h|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   316
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   317
    h := OperatingSystem openPrinter:printerNameString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   318
    ^ OperatingSystem
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   319
	getDocumentProperties:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   320
	hPrinter:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   321
	pDeviceName:printerNameString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   322
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   323
    "Created: / 27-07-2006 / 10:22:32 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   324
    "Modified: / 01-08-2006 / 16:01:44 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   325
    "Modified: / 10-10-2006 / 18:57:45 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   326
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   327
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   328
getPrinterInformationString: printerNameString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   329
	" Answer the printer information string from the WIN.INI file
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   330
	for the printer named printerNameString.  If no name is specified,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   331
	answer the information for the default printer. "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   332
    | printerInfo result |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   333
    printerInfo := ( String new: 80 ).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   334
    result := OperatingSystem primGetProfileString: 'windows'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   335
	keyName:  'device'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   336
	default: ( printerNameString isNil ifTrue: [ '' ] ifFalse: [ printerNameString ] )
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   337
	returnedString: printerInfo
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   338
	size: printerInfo size.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   339
    ^result > 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   340
	ifTrue: [printerInfo copyFrom: 1 to: result]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   341
	ifFalse: ['']
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   342
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   343
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   344
named: aName
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   345
    "Answer a new instance of Printer which represents
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   346
     the printer named aName as specified in the host
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   347
     Control Panel."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   348
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   349
    aName isNil ifTrue: [ ^self default ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   350
    ^self new printerInfoWithName: aName
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   351
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   352
    "Created: / 27-07-2006 / 17:51:27 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   353
    "Modified: / 02-08-2006 / 17:26:29 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   354
    "Modified: / 10-10-2006 / 17:33:29 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   355
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   356
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   357
postScriptBlackWhite
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   358
    "Returns true if the postscript is b&w or returns false if the postscript is color"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   359
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   360
    ^ PostScriptBlackWhite ? false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   361
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   362
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   363
postScriptBlackWhite: aBoolean
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   364
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   365
    PostScriptBlackWhite := aBoolean
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   366
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   367
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   368
!WinPrinterContext class methodsFor:'not supported yet'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   369
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   370
printAdvancedLines: pairOfPointsArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   371
    "Opens a print dialog and prints the given lines"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   372
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   373
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   374
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   375
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   376
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   377
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   378
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   379
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   380
	printer startPrintJob: 'Advanced Lines'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   381
	printer foreground:Color red background:Color white.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   382
	pairOfPointsArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   383
	    do:[:pairOfPointsAndContext |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   384
		 |pairOfPoints|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   385
		 pairOfPoints := pairOfPointsAndContext at:1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   386
		 printer
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   387
		    lineWidth: (pairOfPointsAndContext at:2);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   388
		    lineStyle: (pairOfPointsAndContext at:3);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   389
		    capStyle: (pairOfPointsAndContext at:4);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   390
		    joinStyle: (pairOfPointsAndContext at:5);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   391
		    foreground: (pairOfPointsAndContext at:6);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   392
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   393
		    displayAdvanceLineFrom: (pairOfPoints at:1)  to: (pairOfPoints at:2).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   394
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   395
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   396
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   397
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   398
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   399
     WinPrinterContext printAdvancedLines:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   400
	(Array with: (Array with: (Array with:10@10 with:1000@5000) with: 3 with:#dashed with: #butt with: #miter with: Color green)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   401
	       with: (Array with: (Array with:10@10 with:3500@2000) with: 2 with:#solid  with: #butt with: #miter with: Color yellow)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   402
	       with: (Array with: (Array with:1000@800 with:6000@5000) with: 8 with:#dashed  with: #butt with: #miter with: Color black)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   403
	       with: (Array with: (Array with:2000@2800 with:2000@5000) with: 1 with:#dashed  with: #butt with: #miter with: Color red)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   404
	)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   405
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   406
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   407
    "Created: / 07-08-2006 / 12:09:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   408
    "Modified: / 07-08-2006 / 14:11:17 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   409
    "Modified: / 16-04-2007 / 15:37:41 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   410
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   411
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   412
!WinPrinterContext class methodsFor:'testing'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   413
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   414
computeScaleForPrinter:aPrinter
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   415
    ^ Point x:(aPrinter pixelsPerInchOfScreenWidth / Screen current horizontalPixelPerInch)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   416
	    y:(aPrinter pixelsPerInchOfScreenHeight / Screen current verticalPixelPerInch)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   417
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   418
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   419
testPrintingDo:anOneArgBlock
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   420
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   421
    "Opens a print dialog and invokes the action with the printer"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   422
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   423
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   424
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   425
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   426
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   427
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   428
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   429
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   430
    printer startPrintJob: 'Testing'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   431
    anOneArgBlock value:printer.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   432
    printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   433
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   434
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   435
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   436
self testPrintingDo:[:aPrinter| |icon|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   437
    aPrinter scale:(self computeScaleForPrinter:aPrinter).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   438
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   439
    aPrinter displayLineFrom:10@10   to:100@10.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   440
    aPrinter displayLineFrom:100@10  to:100@100.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   441
    aPrinter displayLineFrom:100@100 to:10@100.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   442
    aPrinter displayLineFrom:10@100  to:10@10.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   443
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   444
    icon := XPToolbarIconLibrary eraseXP28x28Icon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   445
    icon displayOn:aPrinter x:10 y:10.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   446
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   447
].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   448
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   449
self testPrintingDo:[:aPrinter| |scale|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   450
    scale := self computeScaleForPrinter:aPrinter.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   451
    aPrinter scale:(1 * scale).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   452
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   453
    aPrinter  font:(Font family:'Arial' face:'medium' size:8).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   454
    aPrinter displayLineFrom:8@16 to:100@16.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   455
    aPrinter displayLineFrom:8@16 to:8@128.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   456
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   457
    'hallo' displayOn:aPrinter x:8 y:16.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   458
    aPrinter scale:(2 * scale).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   459
    'hallo' displayOn:aPrinter x:4 y:32.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   460
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   461
    aPrinter scale:(4 * scale).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   462
    'hallo' displayOn:aPrinter x:2 y:32.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   463
].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   464
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   465
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   466
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   467
!WinPrinterContext class methodsFor:'testing & examples'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   468
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   469
fillCircles: arrayOfPointsAndRadiusWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   470
    "Opens a print dialog and prints the given circles"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   471
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   472
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   473
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   474
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   475
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   476
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   477
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   478
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   479
	printer startPrintJob: 'Fill Circles'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   480
	arrayOfPointsAndRadiusWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   481
	    do:[:pointsAndRadiusWithContextArray |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   482
		printer foreground:(pointsAndRadiusWithContextArray at:3).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   483
		printer fillCircle:(pointsAndRadiusWithContextArray at:1)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   484
			radius:(pointsAndRadiusWithContextArray at:2).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   485
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   486
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   487
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   488
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   489
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   490
     WinPrinterContext fillCircles:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   491
	(Array with: (Array with: 800@800 with: 600 with:Color red)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   492
	       with: (Array with: 1500@1500 with: 1000 with:Color blue)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   493
	       with: (Array with: 4000@2500 with: 2000 with:Color gray))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   494
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   495
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   496
    "Created: / 07-08-2006 / 11:46:52 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   497
    "Modified: / 16-04-2007 / 15:37:34 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   498
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   499
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   500
fillHatchCircles: arrayOfPointsAndRadiusWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   501
    "Opens a print dialog and prints the given circles"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   502
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   503
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   504
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   505
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   506
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   507
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   508
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   509
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   510
	printer startPrintJob: 'Fill Hatch Circles'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   511
	arrayOfPointsAndRadiusWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   512
	    do:[:pointsAndRadiusWithContextArray |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   513
		| point radius color hatch|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   514
		point := (pointsAndRadiusWithContextArray at:1).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   515
		radius := (pointsAndRadiusWithContextArray at:2).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   516
		color := (pointsAndRadiusWithContextArray at:3).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   517
		hatch := (pointsAndRadiusWithContextArray at:4).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   518
		printer foreground: color;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   519
			hatch: hatch.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   520
		printer fillCircle:point
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   521
			radius:radius.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   522
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   523
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   524
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   525
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   526
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   527
     WinPrinterContext fillHatchCircles:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   528
	(Array with: (Array with: 800@800 with: 600 with:Color red with: #diagonalCross)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   529
	       with: (Array with: 1500@1500 with: 1000 with:Color blue with: #vertical)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   530
	       with: (Array with: 4000@2500 with: 2000 with:Color gray with: #bDiagonal))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   531
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   532
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   533
    "Created: / 07-08-2006 / 11:46:52 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   534
    "Modified: / 16-04-2007 / 15:37:34 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   535
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   536
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   537
fillHatchPolygons: polygonsWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   538
    "Opens a print dialog and prints the given polygons"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   539
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   540
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   541
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   542
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   543
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   544
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   545
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   546
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   547
	printer startPrintJob: 'Fill Hatch Polygons'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   548
	polygonsWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   549
	    do:[:polygonWithContextArray |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   550
		 |aPolygon color hatch|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   551
		 aPolygon := polygonWithContextArray at: 1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   552
		 color := (polygonWithContextArray at: 2).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   553
		 hatch := (polygonWithContextArray at: 3).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   554
		 printer foreground: color;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   555
			 hatch: hatch.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   556
		 aPolygon displayFilledOn: printer.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   557
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   558
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   559
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   560
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   561
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   562
     WinPrinterContext fillHatchPolygons:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   563
	(Array with: (Array with: (Polygon vertices:(
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   564
				Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   565
				    with:100@100
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   566
				    with:600@1000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   567
				    with:3500@4000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   568
				    with:100@4000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   569
				    with:100@100))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   570
			    with: Color red
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   571
			    with: #cross)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   572
		with: (Array with: (Polygon vertices:(
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   573
				Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   574
				    with:1000@1000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   575
				    with:1000@2000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   576
				    with:2000@1000))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   577
			     with: Color blue
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   578
			     with: #none)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   579
    )
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   580
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   581
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   582
    "Created: / 07-08-2006 / 12:09:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   583
    "Modified: / 07-08-2006 / 14:11:17 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   584
    "Modified: / 16-04-2007 / 15:37:43 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   585
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   586
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   587
fillHatchRectangles: rectanglesWithHatch
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   588
    "Opens a print dialog and prints the given rectangles"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   589
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   590
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   591
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   592
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   593
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   594
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   595
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   596
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   597
	printer startPrintJob: 'Fill Hatch Rectangles'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   598
	printer foreground:Color blue background:Color white.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   599
	rectanglesWithHatch
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   600
	    do:[:rectangleWithHatch |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   601
		|rectangle hatch|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   602
		rectangle := rectangleWithHatch at: 1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   603
		hatch := rectangleWithHatch at: 2.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   604
		printer hatch: hatch.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   605
		printer fillRectangleX: rectangle origin x
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   606
			y: rectangle origin y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   607
			width: rectangle width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   608
			height: rectangle height.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   609
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   610
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   611
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   612
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   613
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   614
     WinPrinterContext fillHatchRectangles:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   615
	(Array with: (Array with: (Rectangle left:20 top:20 width:400 height:600) with: #horizontal)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   616
	       with: (Array with: (Rectangle left:500 top:700 width:600 height:400) with: #vertical)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   617
	       with: (Array with: (Rectangle left:800 top:1000 width:1600 height:2000) with: #cross)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   618
	       with: (Array with: (Rectangle left:1040 top:1240 width:3000 height:3000) with: #bDiagonal)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   619
	)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   620
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   621
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   622
    "Created: / 07-08-2006 / 11:40:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   623
    "Modified: / 16-04-2007 / 15:37:46 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   624
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   625
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   626
fillPolygons: polygonsWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   627
    "Opens a print dialog and prints the given polygons"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   628
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   629
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   630
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   631
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   632
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   633
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   634
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   635
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   636
	printer startPrintJob: 'Fill Polygons'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   637
	polygonsWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   638
	    do:[:polygonWithContextArray |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   639
		 |aPolygon|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   640
		 aPolygon := polygonWithContextArray at: 1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   641
		 printer foreground:(polygonWithContextArray at: 2).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   642
		 aPolygon displayFilledOn: printer.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   643
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   644
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   645
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   646
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   647
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   648
     WinPrinterContext fillPolygons:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   649
	(Array with: (Array with: (Polygon vertices:(
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   650
				Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   651
				    with:100@100
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   652
				    with:600@1000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   653
				    with:3500@4000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   654
				    with:100@4000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   655
				    with:100@100))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   656
			    with: Color red)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   657
		with: (Array with: (Polygon vertices:(
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   658
				Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   659
				    with:1000@1000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   660
				    with:1000@2000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   661
				    with:2000@1000))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   662
			     with: Color blue)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   663
    )
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   664
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   665
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   666
    "Created: / 07-08-2006 / 12:09:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   667
    "Modified: / 07-08-2006 / 14:11:17 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   668
    "Modified: / 16-04-2007 / 15:37:43 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   669
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   670
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   671
fillRectangles: rectangles
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   672
    "Opens a print dialog and prints the given rectangles"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   673
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   674
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   675
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   676
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   677
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   678
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   679
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   680
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   681
	printer startPrintJob: 'Fill Rectangles'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   682
	printer foreground:Color blue background:Color white.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   683
	rectangles
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   684
	    do:[:rectangle |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   685
		printer fillRectangleX: rectangle origin x
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   686
			y: rectangle origin y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   687
			width: rectangle width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   688
			height: rectangle height.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   689
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   690
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   691
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   692
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   693
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   694
     WinPrinterContext fillRectangles:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   695
	(Array with: (Rectangle left:20 top:20 width:400 height:600)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   696
	       with: (Rectangle left:500 top:700 width:600 height:400)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   697
	       with: (Rectangle left:800 top:1000 width:1600 height:2000)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   698
	       with: (Rectangle left:1040 top:1240 width:3000 height:3000)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   699
	)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   700
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   701
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   702
    "Created: / 07-08-2006 / 11:40:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   703
    "Modified: / 16-04-2007 / 15:37:46 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   704
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   705
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   706
print: aString font: aFont title: aTitle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   707
    "Open a print dialog to allow printing of the given string
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   708
     using the given title & font."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   709
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   710
    self print: aString font: aFont title: aTitle wordWrap: false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   711
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   712
   "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   713
    WinPrinterContext print: 'Holaaaa!! (from:  WinPrinterContext>>print:aString font:aFont title:aTitle)' font: nil title: 'Printing Test'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   714
    WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: nil title: 'Printing Test String'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   715
    WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: (Font family:'Arial' face:'medium' size:8) title: 'Printing Test String'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   716
   "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   717
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   718
    "Created: / 27-07-2006 / 17:52:33 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   719
    "Modified: / 03-08-2006 / 18:52:31 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   720
    "Modified: / 16-04-2007 / 13:54:40 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   721
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   722
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   723
print: aString font: aFont title: aTitle wordWrap: wordWrap
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   724
    "Open a print dialog to allow printing of the given string
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   725
     using the given title & font."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   726
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   727
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   728
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   729
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   730
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   731
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   732
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   733
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   734
	printer
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   735
	    print: aString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   736
	    font: aFont
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   737
	    title: aTitle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   738
	    wordWrap: wordWrap
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   739
	    marginsRect: nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   740
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   741
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   742
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   743
     WinPrinterContext print: 'Holaaaa!! (from:  PrinterContext>>print:aString font:aFont title:aTitle)' font: nil title: 'Printing Test' wordWrap: true
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   744
     WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font:nil title:'Printing Test String' wordWrap:true
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   745
     WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: (Font family:'Arial' face:'medium' size:8) title: 'Printing Test String' wordWrap: true
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   746
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   747
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   748
    "Created: / 03-08-2006 / 18:51:53 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   749
    "Modified: / 16-04-2007 / 15:37:31 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   750
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   751
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   752
printCircles: arrayOfPointsAndRadius
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   753
    "Opens a print dialog and prints the given circles"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   754
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   755
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   756
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   757
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   758
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   759
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   760
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   761
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   762
	printer startPrintJob: 'Circles'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   763
	printer foreground:Color green background:Color white.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   764
	arrayOfPointsAndRadius
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   765
	    do:[:pointAndRadius |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   766
		printer displayCircle:(pointAndRadius at:1)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   767
			radius:(pointAndRadius at:2).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   768
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   769
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   770
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   771
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   772
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   773
     WinPrinterContext printCircles:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   774
	(Array with: (Array with: 800@800 with: 600)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   775
	       with: (Array with: 1500@1500 with: 1000)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   776
	       with: (Array with: 4000@2500 with: 2000))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   777
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   778
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   779
    "Created: / 07-08-2006 / 11:46:52 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   780
    "Modified: / 16-04-2007 / 15:37:34 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   781
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   782
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   783
printCirclesIn: rectangles
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   784
    "Opens a print dialog and prints the given circles"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   785
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   786
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   787
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   788
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   789
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   790
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   791
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   792
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   793
	printer startPrintJob: 'Circles In Rectangles'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   794
	rectangles
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   795
	   do:[:rectangle |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   796
	       printer displayCircleIn: rectangle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   797
	   ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   798
       printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   799
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   800
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   801
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   802
     WinPrinterContext printCirclesIn:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   803
	(Array with: (Rectangle left:20 top:20 width:400 height:600)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   804
	       with: (Rectangle left:40 top:40 width:600 height:400)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   805
	)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   806
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   807
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   808
    "Created: / 07-08-2006 / 11:48:46 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   809
    "Modified: / 16-04-2007 / 15:37:38 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   810
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   811
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   812
printImage: anImage
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   813
    "Opens a print dialog and prints the given image"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   814
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   815
    self printImage: anImage magnification:1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   816
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   817
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   818
     WinPrinterContext printImage: (Image fromFile:'C:\vsw311\pavheadr.gif').
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   819
     WinPrinterContext printImage: XPToolbarIconLibrary help32x32Icon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   820
     WinPrinterContext printImage: XPToolbarIconLibrary eraseXP28x28Icon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   821
     WinPrinterContext printImage: XPToolbarIconLibrary saveImageBlack22x22Icon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   822
     WinPrinterContext printImage: XPToolbarIconLibrary changesBrowser18x22Icon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   823
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   824
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   825
    "Created: / 07-08-2006 / 11:46:52 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   826
    "Modified: / 16-04-2007 / 15:37:34 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   827
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   828
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   829
printImage:anImage magnification:factor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   830
    "Opens a print dialog and prints the given image"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   831
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   832
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   833
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   834
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   835
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   836
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   837
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   838
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   839
	printer startPrintJob: 'Image'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   840
	printer background:Color white.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   841
	(anImage magnifiedBy:factor) displayOn:printer x:0 y:0.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   842
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   843
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   844
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   845
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   846
     WinPrinterContext printImage: (Image fromFile:'C:\vsw311\pavheadr.gif').
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   847
     WinPrinterContext printImage: XPToolbarIconLibrary help32x32Icon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   848
     WinPrinterContext printImage: XPToolbarIconLibrary eraseXP28x28Icon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   849
     WinPrinterContext printImage: XPToolbarIconLibrary saveImageBlack22x22Icon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   850
     WinPrinterContext printImage: XPToolbarIconLibrary changesBrowser18x22Icon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   851
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   852
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   853
    "Created: / 07-08-2006 / 11:46:52 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   854
    "Modified: / 16-04-2007 / 15:37:34 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   855
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   856
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   857
printLines: pairOfPointsWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   858
    "Opens a print dialog and prints the given lines"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   859
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   860
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   861
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   862
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   863
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   864
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   865
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   866
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   867
	printer startPrintJob: 'Lines'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   868
	pairOfPointsWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   869
	    do:[:pairOfPointsAndContext |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   870
		 |pairOfPoints|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   871
		 pairOfPoints := pairOfPointsAndContext at: 1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   872
		 printer
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   873
		    foreground:(pairOfPointsAndContext at:2);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   874
		    lineWidth: (pairOfPointsAndContext at:3);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   875
		    lineStyle: (pairOfPointsAndContext at:4);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   876
		    displayLineFrom: (pairOfPoints at:1)  to: (pairOfPoints at:2).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   877
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   878
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   879
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   880
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   881
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   882
     WinPrinterContext printLines:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   883
	(Array with: (Array with:(Array with:10@10 with:1000@5000) with: Color red with:4 with: #solid)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   884
	       with: (Array with:(Array with:10@10 with:3500@2000) with: Color blue with:1 with: #dashed)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   885
	       with: (Array with:(Array with:1000@800 with:6000@5000) with: Color black with: 1 with:#dotted)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   886
	       with: (Array with: (Array with:2000@2800 with:2000@5000) with: Color green with:8 with: nil))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   887
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   888
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   889
    "Created: / 07-08-2006 / 12:09:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   890
    "Modified: / 07-08-2006 / 14:11:17 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   891
    "Modified: / 16-04-2007 / 15:37:41 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   892
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   893
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   894
printPoints: aCollectionOfPoints
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   895
    "Opens a print dialog and prints the given points"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   896
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   897
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   898
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   899
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   900
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   901
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   902
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   903
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   904
	printer startPrintJob: 'Points'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   905
	aCollectionOfPoints do:[:each |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   906
	    printer displayPointX: each x y: each y.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   907
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   908
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   909
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   910
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   911
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   912
     WinPrinterContext printPoints:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   913
	(Array with: (10 @ 10)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   914
	       with: (500 @ 700)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   915
	       with: (900 @ 1000)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   916
	       with: (1500 @ 1700)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   917
	       with: (2100 @ 2000)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   918
	       with: (2500 @ 2700)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   919
	)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   920
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   921
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   922
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   923
printPolygons: polygons
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   924
    "Opens a print dialog and prints the given polygons"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   925
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   926
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   927
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   928
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   929
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   930
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   931
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   932
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   933
	printer startPrintJob: 'Polygons'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   934
	printer foreground:Color black background:Color white.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   935
	polygons
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   936
	    do:[:aPolygon |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   937
		 aPolygon displayStrokedOn: printer.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   938
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   939
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   940
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   941
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   942
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   943
     WinPrinterContext printPolygons:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   944
	(Array with: (Polygon vertices:(
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   945
				Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   946
				    with:100@100
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   947
				    with:600@1000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   948
				    with:3500@4000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   949
				    with:100@4000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   950
				    with:100@100))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   951
		with: (Polygon vertices:(
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   952
				Array
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   953
				    with:1000@1000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   954
				    with:1000@2000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   955
				    with:2000@1000)))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   956
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   957
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   958
    "Created: / 07-08-2006 / 12:09:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   959
    "Modified: / 07-08-2006 / 14:11:17 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   960
    "Modified: / 16-04-2007 / 15:37:43 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   961
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   962
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   963
printPolylines: evenCollectionOfPoints
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   964
    "Opens a print dialog and prints the given rectangles"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   965
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   966
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   967
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   968
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   969
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   970
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   971
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   972
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   973
	printer startPrintJob: 'Polylines'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   974
	printer displayPolylines:evenCollectionOfPoints.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   975
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   976
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   977
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   978
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   979
     WinPrinterContext printPolylines:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   980
	(Array with: (10 @ 10)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   981
	       with: (500 @ 700)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   982
	       with: (900 @ 1000)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   983
	       with: (1500 @ 1700)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   984
	       with: (2100 @ 2000)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   985
	       with: (2500 @ 2700)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   986
	)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   987
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   988
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   989
    "Created: / 07-08-2006 / 11:40:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   990
    "Modified: / 16-04-2007 / 15:37:46 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   991
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   992
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   993
printRectangles: rectanglesWithContextArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   994
    "Opens a print dialog and prints the given rectangles"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   995
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   996
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   997
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   998
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
   999
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1001
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1002
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1003
	printer startPrintJob: 'Rectangles'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1004
	printer foreground:Color red background:Color white.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1005
	rectanglesWithContextArray do:[:rectangleWithContextArray |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1006
	    |rectangle|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1007
	    rectangle := rectangleWithContextArray at: 1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1008
	    printer
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1009
		foreground:(rectangleWithContextArray at:2);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1010
		lineWidth: (rectangleWithContextArray at:3);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1011
		lineStyle: (rectangleWithContextArray at:4);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1012
		displayRectangleX: rectangle origin x
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1013
			y: rectangle origin y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1014
			width: rectangle width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1015
			height: rectangle height.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1016
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1017
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1018
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1019
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1020
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1021
     WinPrinterContext printRectangles:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1022
	(Array with: (Array with: (Rectangle left:30 top:10 width:400 height:600) with: Color red with:4 with: #solid)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1023
	       with: (Array with: (Rectangle left:100 top:140 width:700 height:800) with: Color blue with:1 with: #dashed)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1024
	       with: (Array with: (Rectangle left:800 top:1500 width:2600 height:3400) with: Color green with:1 with: #dotted)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1025
	       with: (Array with: (Rectangle left:1000 top:1200 width:1400 height:1600) with: Color gray with:8 with: #dashed)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1026
	       with: (Array with: (Rectangle left:2600 top:1200 width:1400 height:1600) with: Color darkGray with:1 with: #dashDotDot)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1027
	)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1028
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1029
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1030
    "Created: / 07-08-2006 / 11:40:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1031
    "Modified: / 16-04-2007 / 15:37:46 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1032
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1033
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1034
printStrings: stringAndPositionsArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1035
    "Opens a print dialog and prints the given strings"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1036
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1037
    | printerInfo printer |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1038
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1039
    printerInfo := PrintingDialog getPrinterInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1040
    printerInfo isNil ifTrue:[^self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1041
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1042
    printer := self fromPrinterInfo: printerInfo.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1043
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1044
	printer startPrintJob: 'Strings with Position'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1045
	printer foreground:Color black background:Color white.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1046
	stringAndPositionsArray
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1047
	    do:[:pairOfPointsAndPosition |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1048
		 printer displayString:(pairOfPointsAndPosition at: 1)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1049
			    x:(pairOfPointsAndPosition at: 2) x
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1050
			    y:(pairOfPointsAndPosition at: 2) y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1051
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1052
	printer endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1053
    ] forkAt: 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1054
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1055
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1056
     WinPrinterContext printStrings:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1057
	(Array with: (Array with:'Testing printing with standard method' with:10@10)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1058
	       with: (Array with:'Another test string to print' with:80@200))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1059
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1060
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1061
    "Created: / 07-08-2006 / 12:09:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1062
    "Modified: / 07-08-2006 / 14:11:17 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1063
    "Modified: / 16-04-2007 / 15:37:49 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1064
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1065
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1066
!WinPrinterContext methodsFor:'accessing'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1067
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1068
depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1069
    ^ 24
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1070
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1071
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1072
deviceColors
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1073
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1074
    ^#()
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1075
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1076
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1077
deviceFonts
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1078
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1079
    deviceFonts isNil ifTrue:[deviceFonts := CachingRegistry new cacheSize:10.].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1080
    ^deviceFonts
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1081
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1082
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1083
getCharHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1084
    "Private - answer the height of the font selected in the receiver's
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1085
     device context."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1086
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1087
    |textMetrics answer|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1088
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1089
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1090
    textMetrics := Win32OperatingSystem::TextMetricsStructure new.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1091
"/    (OperatingSystem getTextMetrics:gcId lpMetrics:textMetrics) ifFalse:[ ^ self error ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1092
"/    Transcript showCR: 'CHAR HEIGHT PRIM ******* ', '   ',  (textMetrics tmHeight + textMetrics tmExternalLeading) printString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1093
"/    Transcript showCR: 'CHAR HEIGHT DEVICE ***** ', '   ', (self font heightOf:'PQWEXCZ' on:self device) printString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1094
    answer := (self font heightOf:'PQWEXCZ' on:self device).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1095
"/    answer := textMetrics tmHeight + textMetrics tmExternalLeading.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1096
    ^answer
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1097
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1098
    "Created: / 02-08-2006 / 17:47:20 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1099
    "Modified: / 03-08-2006 / 10:09:01 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1100
    "Modified: / 10-10-2006 / 18:15:17 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1101
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1102
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1103
getLogicalPixelSizeX
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1104
    ^ printerInfo printQuality ? 600
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1105
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1106
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1107
getLogicalPixelSizeY
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1108
    ^ printerInfo printQuality ? 600
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1109
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1110
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1111
numberOfColorBitsPerPixel
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1112
    ^ OperatingSystem getDeviceCaps:self gcId index:12 "Bitspixel"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1113
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1114
    "Created: / 03-08-2006 / 09:58:18 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1115
    "Modified: / 10-10-2006 / 18:15:40 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1116
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1117
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1118
physicalOffsetX
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1119
    ^ OperatingSystem getDeviceCaps:self gcId index:112 "PhysicalOffsetX"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1120
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1121
    "Created: / 01-08-2006 / 16:28:34 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1122
    "Modified: / 16-04-2007 / 12:52:06 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1123
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1124
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1125
physicalOffsetY
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1126
    ^ OperatingSystem getDeviceCaps:self gcId index:113 "PhysicalOffsetY"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1127
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1128
    "Created: / 01-08-2006 / 16:28:34 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1129
    "Modified: / 16-04-2007 / 12:52:01 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1130
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1131
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1132
pixelsPerInchOfScreenHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1133
    ^ OperatingSystem getDeviceCaps:self gcId index:90 "Logpixelsy"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1134
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1135
    "Created: / 01-08-2006 / 16:29:16 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1136
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1137
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1138
pixelsPerInchOfScreenWidth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1139
    ^ OperatingSystem getDeviceCaps:self gcId index:88 "Logpixelsx"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1140
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1141
    "Created: / 01-08-2006 / 16:28:34 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1142
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1143
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1144
printerHeightArea
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1145
    ^ (OperatingSystem getDeviceCaps:self gcId index:10)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1146
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1147
    "Modified: / 10-10-2006 / 18:18:31 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1148
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1149
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1150
printerPhysicalHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1151
    ^ OperatingSystem getDeviceCaps:self gcId "deviceContext" index:111 "PhysicalHeight"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1152
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1153
    "Created: / 01-08-2006 / 16:14:08 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1154
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1155
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1156
printerPhysicalWidth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1157
    ^ OperatingSystem getDeviceCaps:self gcId "deviceContext" index:110 "PhysicalWidth"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1158
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1159
    "Created: / 01-08-2006 / 16:14:08 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1160
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1161
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1162
printerWidthArea
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1163
    ^ OperatingSystem getDeviceCaps:self gcId "deviceContext" index:8 "Horzres"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1164
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1165
    "Created: / 01-08-2006 / 16:14:08 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1166
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1167
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1168
supportedImageFormats
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1169
    "return an array with supported image formats; each array entry
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1170
     is another array, consisting of depth and bitsPerPixel values."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1171
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1172
    |info|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1173
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1174
    info := IdentityDictionary new.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1175
    info at:#depth put:self depth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1176
    info at:#bitsPerPixel put:self depth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1177
    info at:#padding put:32.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1178
    ^ Array with:info
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1179
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1180
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1181
     Disply supportedImageFormats
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1182
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1183
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1184
    "Modified: / 10.9.1998 / 23:14:05 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1185
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1186
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1187
visualType
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1188
    ^ #TrueColor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1189
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1190
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1191
!WinPrinterContext methodsFor:'color stuff'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1192
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1193
colorScaledRed:r scaledGreen:g scaledBlue:b
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1194
    "allocate a color with rgb values (0..16rFFFF) - return the color index
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1195
     (i.e. colorID)"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1196
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1197
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1198
    int id, ir, ig, ib;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1199
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1200
    if (__bothSmallInteger(r, g) && __isSmallInteger(b)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1201
	ir = (__intVal(r) >> 8) & 0xff;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1202
	ig = (__intVal(g) >> 8) & 0xff;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1203
	ib = (__intVal(b) >> 8) & 0xff;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1204
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1205
	id = RGB( ir, ig, ib);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1206
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1207
	RETURN ( __MKSMALLINT(id) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1208
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1209
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1210
    self primitiveFailed.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1211
    ^ nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1212
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1213
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1214
setBackground:bgColorIndex in:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1215
    "set background color to be drawn with"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1216
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1217
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1218
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1219
    HDC hDC;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1220
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1221
    if (__isExternalAddressLike(aDC)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1222
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1223
	COLORREF bg, oldBg;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1224
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1225
	oldBg = GetBkColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1226
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1227
	bg = __intVal(bgColorIndex) & 0xffffff;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1228
/*        bg = (COLORREF)st2RGB(__intVal(bgColorIndex),gcData);         */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1229
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1230
	if (bg != oldBg) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1231
	    SetBkColor(hDC, bg);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1232
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1233
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1234
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1235
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1236
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1237
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1238
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1239
setBackgroundColor:color in:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1240
    "set background color to be drawn with"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1241
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1242
    |colorId deviceColor|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1243
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1244
    (color isOnDevice:self) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1245
	colorId := color colorId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1246
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1247
	deviceColor := color onDevice:self.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1248
	deviceColor notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1249
	    colorId := deviceColor colorId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1250
	]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1251
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1252
    colorId isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1253
	'DeviceWorkstation [warning]: could not set bg color' infoPrintCR.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1254
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1255
	self setBackground:colorId in:aGCId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1256
    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1257
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1258
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1259
setForeground:fgColorIndex background:bgColorIndex in:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1260
    "set foreground and background colors to be drawn with"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1261
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1262
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1263
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1264
    if (__isExternalAddressLike(aDC)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1265
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1266
	COLORREF fg, bg, oldFg, oldBg;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1267
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1268
/*        fg = (COLORREF)st2RGB(__intVal(fgColorIndex),gcData);    */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1269
	fg = __intVal(fgColorIndex) & 0xffffff;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1270
/*        bg = (COLORREF)st2RGB(__intVal(bgColorIndex),gcData);    */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1271
	bg = __intVal(bgColorIndex) & 0xffffff;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1272
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1273
	oldFg = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1274
	oldBg = GetBkColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1275
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1276
	if ((fg != oldFg) || (bg != oldBg)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1277
	    /* Pen only depends upon fg-color */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1278
	    if (fg != oldFg) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1279
		SetTextColor(hDC, fg);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1280
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1281
	    if (bg != oldBg) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1282
		SetBkColor(hDC, bg);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1283
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1284
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1285
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1286
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1287
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1288
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1289
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1290
setForeground:fgColorIndex in:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1291
    "set foreground color to be drawn with"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1292
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1293
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1294
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1295
    HDC hDC;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1296
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1297
    if (__isExternalAddressLike(aDC)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1298
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1299
	COLORREF fg, oldFg;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1300
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1301
	oldFg = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1302
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1303
	fg = __intVal(fgColorIndex) & 0xffffff;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1304
/*        fg = (COLORREF)st2RGB(__intVal(fgColorIndex),gcData);         */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1305
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1306
	if (fg != oldFg) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1307
	    SetTextColor(hDC, fg);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1308
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1309
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1310
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1311
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1312
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1313
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1314
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1315
setForegroundColor:color in:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1316
    "set the foreground color to be drawn with"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1317
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1318
    |colorId deviceColor|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1319
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1320
    (color isOnDevice:self) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1321
	colorId := color colorId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1322
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1323
	deviceColor := color onDevice:self.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1324
	deviceColor notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1325
	    colorId := deviceColor colorId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1326
	]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1327
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1328
    colorId isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1329
	'DeviceWorkstation [warning]: could not set fg color' infoPrintCR.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1330
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1331
	self setForeground:colorId in:aGCId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1332
    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1333
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1334
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1335
!WinPrinterContext methodsFor:'context stuff'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1336
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1337
getPenFor:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1338
    "set line attributes"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1339
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1340
    | lineWidthObj lineStyleObj capStyleObj joinStyleObj |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1341
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1342
	lineWidthObj := self lineWidth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1343
	lineStyleObj := self lineStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1344
	 capStyleObj := self capStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1345
	joinStyleObj := self joinStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1346
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1347
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1348
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1349
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1350
     && __isSmallInteger(lineWidthObj)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1351
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1352
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1353
	HANDLE hPen, prevPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1354
	int lineStyleInt, capStyleInt, joinStyleInt, lineWidth;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1355
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1356
	lineWidth= __intVal(lineWidthObj);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1357
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1358
	if (lineStyleObj == @symbol(solid)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1359
	    lineStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1360
	} else if (lineStyleObj == @symbol(dashed)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1361
	    lineStyleInt= PS_DASH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1362
	} else if (lineStyleObj == @symbol(dotted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1363
	    lineStyleInt= PS_DOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1364
	} else if (lineStyleObj == @symbol(dashDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1365
	    lineStyleInt= PS_DASHDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1366
	} else if (lineStyleObj == @symbol(dashDotDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1367
	    lineStyleInt= PS_DASHDOTDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1368
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1369
	    lineStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1370
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1371
	if (capStyleObj == @symbol(round)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1372
	    capStyleInt= PS_ENDCAP_ROUND;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1373
	} else if (capStyleObj == @symbol(square)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1374
	    capStyleInt= PS_ENDCAP_SQUARE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1375
	} else if (capStyleObj == @symbol(flat)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1376
	    capStyleInt= PS_ENDCAP_FLAT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1377
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1378
	    capStyleInt= PS_ENDCAP_FLAT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1379
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1380
	if (joinStyleObj == @symbol(bevel)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1381
	    joinStyleInt= PS_JOIN_BEVEL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1382
	} else if (joinStyleObj== @symbol(miter)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1383
	    joinStyleInt= PS_JOIN_MITER;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1384
	} else if (joinStyleObj == @symbol(round)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1385
	    joinStyleInt= PS_JOIN_ROUND;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1386
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1387
	    joinStyleInt= PS_JOIN_MITER;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1388
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1389
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1390
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1391
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1392
	hPen = CreatePen(lineStyleInt | capStyleInt | joinStyleInt, lineWidth, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1393
	prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1394
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1395
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1396
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1397
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1398
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1399
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1400
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1401
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1402
getPenForContext
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1403
    "set line attributes"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1404
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1405
   | gcId  lineWidthObj lineStyleObj capStyleObj joinStyleObj |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1406
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1407
   gcId := self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1408
	lineWidthObj := self lineWidth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1409
	lineStyleObj := self lineStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1410
	 capStyleObj := self capStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1411
	joinStyleObj := self joinStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1412
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1413
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1414
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1415
    if (__isExternalAddressLike(gcId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1416
     && __isSmallInteger(lineWidthObj) ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1417
	HANDLE hDC = (HANDLE)(__externalAddressVal(gcId));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1418
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1419
	HANDLE hPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1420
	int lineStyleInt, capStyleInt, joinStyleInt, lineWidth;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1421
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1422
	lineWidth= lineWidthObj;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1423
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1424
	if (lineStyleObj == @symbol(solid)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1425
	    lineStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1426
	} else if (lineStyleObj == @symbol(dashed)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1427
	    lineStyleInt= PS_DASH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1428
	} else if (lineStyleObj == @symbol(dotted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1429
	    lineStyleInt= PS_DOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1430
	} else if (lineStyleObj == @symbol(dashDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1431
	    lineStyleInt= PS_DASHDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1432
	} else if (lineStyleObj == @symbol(dashDotDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1433
	    lineStyleInt= PS_DASHDOTDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1434
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1435
	    lineStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1436
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1437
	if (capStyleObj == @symbol(round)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1438
	    capStyleInt= PS_ENDCAP_ROUND;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1439
	} else if (capStyleObj == @symbol(square)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1440
	    capStyleInt= PS_ENDCAP_SQUARE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1441
	} else if (capStyleObj == @symbol(flat)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1442
	    capStyleInt= PS_ENDCAP_FLAT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1443
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1444
	    capStyleInt= PS_ENDCAP_FLAT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1445
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1446
	if (joinStyleObj == @symbol(bevel)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1447
	    joinStyleInt= PS_JOIN_BEVEL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1448
	} else if (joinStyleObj == @symbol(miter)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1449
	    joinStyleInt= PS_JOIN_MITER;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1450
	} else if (joinStyleObj== @symbol(round)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1451
	    joinStyleInt= PS_JOIN_ROUND;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1452
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1453
	    joinStyleInt= PS_JOIN_MITER;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1454
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1455
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1456
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1457
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1458
	hPen = CreatePen(lineStyleInt | capStyleInt | joinStyleInt, lineWidth, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1459
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1460
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1461
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1462
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1463
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1464
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1465
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1466
hatch
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1467
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1468
    "The hatch style will define a hatched brush between these patterns:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1469
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1470
       #none
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1471
       #horizontal              -----       HS_HORIZONTAL = 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1472
       #vertical                |||||       HS_VERTICAL = 1
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1473
       #fDiagonal               \\\\\       HS_FDIAGONAL = 2
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1474
       #bDiagonal               /////       HS_BDIAGONAL = 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1475
       #cross                   +++++       HS_CROSS = 4
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1476
       #diagonalCross           xxxxx       HS_DIAGCROSS = 5
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1477
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1478
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1479
    hatch isNil ifTrue:[^#none].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1480
    ^ hatch
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1481
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1482
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1483
hatch: aSymbol
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1484
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1485
    "The hatch style will define a hatched brush between these patterns:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1486
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1487
       #none
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1488
       #horizontal              -----       HS_HORIZONTAL = 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1489
       #vertical                |||||       HS_VERTICAL = 1
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1490
       #fDiagonal               \\\\\       HS_FDIAGONAL = 2
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1491
       #bDiagonal               /////       HS_BDIAGONAL = 3
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1492
       #cross                   +++++       HS_CROSS = 4
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1493
       #diagonalCross           xxxxx       HS_DIAGCROSS = 5
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1494
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1495
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1496
    hatch := aSymbol
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1497
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1498
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1499
noClipIn:aWindowId gc:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1500
    "disable clipping rectangle"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1501
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1502
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1503
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1504
    if (__isExternalAddressLike(aDC)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1505
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1506
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1507
	SelectClipRgn(hDC, NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1508
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1509
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1510
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1511
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1512
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1513
platformName
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1514
    "used by #fillRoundRectangleX ...."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1515
    ^ Smalltalk platformName asUppercase
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1516
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1517
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1518
setBitmapMask:aBitmapId in:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1519
    "set or clear the drawing mask - a bitmap mask using current fg/bg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1520
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1521
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1522
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1523
    if (__isExternalAddressLike(aDC)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1524
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1525
	HBITMAP oldM;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1526
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1527
/*        oldM = gcData->hMask;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1528
	if (__isExternalAddress(aBitmapId))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1529
	    gcData->hMask = _HBITMAPVAL(aBitmapId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1530
	else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1531
	    gcData->hMask = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1532
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1533
	if (oldM != gcData->hMask) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1534
	  FLUSH_CACHED_DC(gcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1535
	    CPRINTF(("masks set to %x\n",gcData->hMask));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1536
	}                                                     */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1537
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1538
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1539
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1540
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1541
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1542
setClipX:clipX y:clipY width:clipWidth height:clipHeight in:ignoredDrawableId gc:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1543
    "clip to a rectangle"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1544
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1545
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1546
      p--w---
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1547
      |     |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1548
      h     |  the clipping rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1549
      |     |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1550
      -------
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1551
	  where p = ( clipX, clipY ), w = clipWidth, h = clipHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1552
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1553
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1554
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1555
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1556
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1557
     && __bothSmallInteger(clipX, clipY)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1558
     && __bothSmallInteger(clipWidth, clipHeight) ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1559
	HANDLE hDC;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1560
	int cX, cY, cW, cH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1561
	POINT ptOrg;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1562
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1563
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1564
	hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1565
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1566
	GetViewportOrgEx(hDC,&ptOrg);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1567
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1568
	// set the clip rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1569
	// and offset the rectangle by the viewport origin
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1570
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1571
	cX = __intVal(clipX) + ptOrg.x;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1572
	cY = __intVal(clipY) + ptOrg.y;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1573
	cW = __intVal(clipWidth)+ ptOrg.x;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1574
	cH = __intVal(clipHeight)+ ptOrg.y;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1575
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1576
	{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1577
	    HRGN region = CreateRectRgn(cX, cY, cX + cW, cY + cH);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1578
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1579
	    if (region == NULL ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1580
		console_fprintf(stderr, "WinWorkstat [warning]: clipping region creation failed\n");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1581
	    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1582
		if (SelectClipRgn(hDC, region) == ERROR ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1583
		    console_fprintf(stderr, "WinWorkstat [warning]: select clipping region failed\n");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1584
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1585
		DeleteObject(region);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1586
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1587
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1588
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1589
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1590
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1591
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1592
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1593
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1594
setDashes:dashList dashOffset:offset in:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1595
    "set line attributes"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1596
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1597
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1598
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1599
    if (__isExternalAddressLike(aGCId)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1600
	DPRINTF(("WinWorkstat [warning]: dashes not (yet) implemented\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1601
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1602
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1603
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1604
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1605
setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1606
    "set line attributes"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1607
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1608
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1609
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1610
    HDC hDC;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1611
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1612
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1613
     && __isSmallInteger(aNumber)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1614
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1615
	int style;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1616
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1617
	if (lineStyle == @symbol(solid)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1618
	    style = PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1619
	} else if (lineStyle == @symbol(dashed)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1620
	    style= PS_DASH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1621
	} else if (lineStyle == @symbol(dotted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1622
	    style= PS_DOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1623
	} else if (lineStyle == @symbol(dashDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1624
	    style= PS_DASHDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1625
	} else if (lineStyle == @symbol(dashDotDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1626
	    style= PS_DASHDOTDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1627
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1628
	    style= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1629
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1630
	if (capStyle == @symbol(round)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1631
	    style = PS_ENDCAP_ROUND;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1632
	} else if (capStyle == @symbol(square)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1633
	    style = PS_ENDCAP_SQUARE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1634
	} else if (capStyle == @symbol(flat)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1635
	    style = PS_ENDCAP_FLAT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1636
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1637
	    style = PS_ENDCAP_FLAT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1638
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1639
	if (joinStyle == @symbol(bevel)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1640
	    style = PS_JOIN_BEVEL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1641
	} else if (joinStyle == @symbol(miter)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1642
	    style = PS_JOIN_MITER;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1643
	} else if (joinStyle == @symbol(round)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1644
	    style = PS_JOIN_ROUND;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1645
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1646
	    style = PS_JOIN_MITER;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1647
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1648
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1649
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1650
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1651
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1652
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1653
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1654
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1655
setMaskOriginX:orgX y:orgY in:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1656
    "set the mask origin"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1657
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1658
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1659
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1660
    if (__isExternalAddress(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1661
     && __bothSmallInteger(orgX,orgY)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1662
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1663
	int oX, oY, maskOrgX, maskOrgY;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1664
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1665
	oX = __intVal(orgX);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1666
	oY = __intVal(orgY);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1667
	if ((oX != maskOrgX)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1668
	 || (oY != maskOrgY)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1669
	    maskOrgX = __intVal(orgX);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1670
	    maskOrgY = __intVal(orgY);;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1671
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1672
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1673
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1674
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1675
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1676
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1677
setViewportOrg: aPoint
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1678
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1679
    "Sets the viewport origin (LOGICAL point (0,0)) of the device context"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1680
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1681
    ^ OperatingSystem
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1682
	    setViewportOrg: self gcId "deviceContext"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1683
	    x: aPoint x
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1684
	    y: aPoint y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1685
	    oldOrigin: nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1686
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1687
    "Created: / 01-08-2006 / 16:14:08 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1688
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1689
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1690
!WinPrinterContext methodsFor:'drawing'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1691
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1692
displayArcX:x y:y width:width height:height from:startAngle angle:angle in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1693
    "draw an arc. If any of x,y, w or h is not an integer, an error is triggered.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1694
     The angles may be floats or integer - they are given in degrees."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1695
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1696
     | lineWidthObj lineStyleObj |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1697
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1698
     lineWidthObj := self lineWidth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1699
     lineStyleObj := self lineStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1700
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1701
    int __x, __y, w, h;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1702
    float angle1, angle2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1703
    double f;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1704
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1705
    if (__isSmallInteger(startAngle))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1706
	angle1 = (float)(__intVal(startAngle));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1707
    else if (__isFloat(startAngle)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1708
	angle1 = (float) __floatVal(startAngle);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1709
    } else if (__isShortFloat(startAngle)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1710
	angle1 = __shortFloatVal(startAngle);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1711
    } else goto bad;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1712
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1713
    if (__isSmallInteger(angle))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1714
	angle2 = (float)(__intVal(angle));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1715
    else if (__isFloat(angle)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1716
	angle2 = (float) __floatVal(angle);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1717
    } else if (__isShortFloat(angle)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1718
	angle2 = __shortFloatVal(angle);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1719
    } else goto bad;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1720
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1721
    if (angle2 <= 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1722
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1723
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1724
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1725
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1726
     && __bothSmallInteger(x, y)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1727
     && __bothSmallInteger(width, height))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1728
     {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1729
	POINT p;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1730
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1731
	DWORD clr = 0 /* 0xFFFFFFFF */;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1732
	HANDLE prevPen, hPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1733
	double xB, yB, xE, yE, xR, yR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1734
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1735
	OBJ lStyleSymbol;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1736
	int lStyleInt;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1737
	int lw;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1738
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1739
	lw= __intVal(lineWidthObj);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1740
	lStyleSymbol= lineStyleObj;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1741
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1742
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1743
	    only works with lineWidth = 1  */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1744
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1745
	if (lStyleSymbol == @symbol(solid)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1746
	    lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1747
	} else if (lStyleSymbol == @symbol(dashed)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1748
	    lStyleInt= PS_DASH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1749
	} else if (lStyleSymbol == @symbol(dotted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1750
	    lStyleInt= PS_DOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1751
	} else if (lStyleSymbol == @symbol(dashDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1752
	    lStyleInt= PS_DASHDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1753
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1754
	    lStyleInt= PS_DASHDOTDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1755
	} else if (lStyleSymbol == @symbol(insideFrame)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1756
	    lStyleInt= PS_INSIDEFRAME;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1757
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1758
	    lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1759
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1760
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1761
	hPen = CreatePen(lStyleInt, lw, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1762
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1763
	w = __intVal(width);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1764
	h = __intVal(height);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1765
	__x = __intVal(x);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1766
	__y = __intVal(y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1767
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1768
	    xR = w / 2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1769
	    yR = h / 2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1770
	    if (angle2 - angle1 >= 360) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1771
		xB = xE = __x + xR + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1772
		yB = yE = __y /*+ yR + 0.5*/;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1773
	    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1774
		double sin(), cos();
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1775
		float rad1, rad2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1776
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1777
		if (angle1 <= 180)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1778
		  angle1 = 180 - angle1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1779
		else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1780
		  angle1 = 360 + 180 - angle1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1781
		angle2 = angle1 - angle2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1782
		/* sigh - compute the intersections ... */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1783
		rad1 = (angle1 * 3.14159265359) / 180.0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1784
		rad2 = (angle2 * 3.14159265359) / 180.0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1785
		xB = cos(rad1) * xR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1786
		yB = sin(rad1) * yR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1787
		xE = cos(rad2) * xR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1788
		yE = sin(rad2) * yR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1789
		xB = __x + xR - xB + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1790
		yB = __y + yR - yB + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1791
		xE = __x + xR - xE + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1792
		yE = __y + yR - yE + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1793
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1794
	    prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1795
	    DPRINTF(("Arc x=%d y=%d w=%d h=%d xB=%d xE=%d yB=%d yE=%d a1=%f a2=%f\n",__x,__y,w,h,(int)xB,(int)xE,(int)yB,(int)yE,angle1,angle2));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1796
	    Arc(hDC,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1797
		__x, __y,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1798
		__x + w, __y + h,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1799
		(int)xB, (int)yB,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1800
		(int)xE, (int)yE);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1801
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1802
	    SelectObject(hDC, prevPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1803
	    DeleteObject(hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1804
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1805
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1806
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1807
    bad: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1808
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1809
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1810
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1811
    "Created: / 07-08-2006 / 10:40:27 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1812
    "Modified: / 07-08-2006 / 14:44:21 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1813
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1814
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1815
displayLineFromX:x0 y:y0 toX:x1 y:y1 in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1816
    "draw a line. If the coordinates are not integers, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1817
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1818
     | lineWidthObj lineStyleObj |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1819
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1820
     lineWidthObj := self lineWidth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1821
     lineStyleObj := self lineStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1822
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1823
%{ 
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1824
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1825
     && __bothSmallInteger(x0, y0)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1826
     && __bothSmallInteger(x1, y1)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1827
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1828
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1829
	HANDLE prevPen, hPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1830
	int __x1 = __intVal(x1), __y1 = __intVal(y1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1831
	OBJ lStyleSymbol;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1832
	int lStyleInt;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1833
	int lw;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1834
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1835
/*      DPRINTF(("displayLine: %d/%d -> %d/%d\n",
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1836
		    __intVal(x0), __intVal(y0),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1837
		    __x1, __y1));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1838
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1839
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1840
	lw= __intVal(lineWidthObj);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1841
	lStyleSymbol= lineStyleObj;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1842
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1843
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1844
	    only works with lineWidth = 1  */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1845
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1846
	if (lStyleSymbol == @symbol(solid)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1847
	    lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1848
	} else if (lStyleSymbol == @symbol(dashed)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1849
	    lStyleInt= PS_DASH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1850
	} else if (lStyleSymbol == @symbol(dotted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1851
	    lStyleInt= PS_DOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1852
	} else if (lStyleSymbol == @symbol(dashDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1853
	    lStyleInt= PS_DASHDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1854
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1855
	    lStyleInt= PS_DASHDOTDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1856
	} else if (lStyleSymbol == @symbol(insideFrame)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1857
	    lStyleInt= PS_INSIDEFRAME;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1858
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1859
	    lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1860
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1861
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1862
	hPen = CreatePen(lStyleInt, lw, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1863
	prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1864
	MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1865
	LineTo(hDC, __x1, __y1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1866
	/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1867
	 * end-point ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1868
	 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1869
	// LineTo(hDC, __x1+1, __y1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1870
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1871
	SelectObject(hDC, prevPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1872
	DeleteObject(hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1873
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1874
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1875
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1876
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1877
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1878
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1879
displayPointX:px y:py in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1880
    "draw a point. If x/y are not integers, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1881
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1882
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1883
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1884
     && __bothSmallInteger(px, py)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1885
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1886
	POINT p;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1887
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1888
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1889
	int __x = __intVal(px), __y = __intVal(py);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1890
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1891
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1892
	SetPixelV(hDC, __x, __y, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1893
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1894
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1895
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1896
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1897
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1898
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1899
displayPolygon:aPolygon in:aDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1900
    "draw a polygon, the argument aPolygon is a Collection of individual points,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1901
     which define the polygon.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1902
     If any coordinate is not integer, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1903
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1904
    | numberOfPoints lineWidthObj lineStyleObj |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1905
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1906
     lineWidthObj := self lineWidth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1907
     lineStyleObj := self lineStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1908
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1909
    numberOfPoints := aPolygon size.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1910
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1911
    OBJ point, px, py;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1912
    int i, num;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1913
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1914
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1915
     /* && __isExternalAddress(aDrawableId) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1916
     && __isSmallInteger(numberOfPoints)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1917
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1918
	POINT p;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1919
	DWORD clr = 0 /* 0xFFFFFFFF */;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1920
	HANDLE prevPen, hPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1921
	int lw;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1922
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1923
	OBJ lStyleSymbol;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1924
	int lStyleInt;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1925
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1926
	lw= __intVal(lineWidthObj);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1927
	lStyleSymbol= lineStyleObj;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1928
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1929
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1930
	    only works with lineWidth = 1  */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1931
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1932
	if (lStyleSymbol == @symbol(solid)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1933
	    lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1934
	} else if (lStyleSymbol == @symbol(dashed)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1935
	    lStyleInt= PS_DASH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1936
	} else if (lStyleSymbol == @symbol(dotted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1937
	    lStyleInt= PS_DOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1938
	} else if (lStyleSymbol == @symbol(dashDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1939
	    lStyleInt= PS_DASHDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1940
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1941
	    lStyleInt= PS_DASHDOTDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1942
	} else if (lStyleSymbol == @symbol(insideFrame)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1943
	    lStyleInt= PS_INSIDEFRAME;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1944
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1945
	    lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1946
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1947
	num = __intVal(numberOfPoints);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1948
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1949
	for (i=0; i<num; i++) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1950
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1951
	    if (! __isPoint(point)) goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1952
	    px = _point_X(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1953
	    py = _point_Y(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1954
	    if (! __bothSmallInteger(px, py)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1955
		goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1956
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1957
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1958
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1959
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1960
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1961
	hPen = CreatePen(lStyleInt, lw, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1962
	prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1963
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1964
	for (i=0; i<num; i++) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1965
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1966
	    px = _point_X(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1967
	    py = _point_Y(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1968
	    p.x = __intVal(px);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1969
	    p.y = __intVal(py);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1970
	    if (i == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1971
		MoveToEx(hDC, p.x, p.y, NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1972
	    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1973
		if (i == (num-1)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1974
		    PolylineTo(hDC, &p, 1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1975
		} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1976
		    LineTo(hDC, p.x, p.y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1977
#ifdef PRE_04_JUN_04
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1978
		    /*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1979
		     * end-point ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1980
		     */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1981
		    LineTo(hDC, p.x+1, p.y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1982
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1983
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1984
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1985
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1986
	SelectObject(hDC, prevPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1987
	DeleteObject(hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1988
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1989
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1990
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1991
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1992
fail: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1993
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1994
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1995
    "Created: / 07-08-2006 / 14:46:55 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1996
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1997
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1998
displayPolylines:arrayOfPoints
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  1999
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2000
    self device displayPolylines:arrayOfPoints in:nil with:self gcId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2001
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2002
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2003
displayPolylines:aPolyline in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2004
    "draw a polyline, the argument aPolyline is a collection of individual points,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2005
     which define the lines (p1/p2 pairs); must be even in size.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2006
     If any coordinate is not integer, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2007
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2008
    |numberOfPoints lineWidthObj lineStyleObj capStyleObj joinStyleObj |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2009
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2010
    numberOfPoints := aPolyline size.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2011
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2012
 	lineWidthObj := self lineWidth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2013
	lineStyleObj := self lineStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2014
	
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2015
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2016
    OBJ point, px, py;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2017
    int i, num;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2018
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2019
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2020
     && __isSmallInteger(numberOfPoints)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2021
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2022
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2023
	POINT p;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2024
	HANDLE prevPen, hPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2025
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2026
	int lw;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2027
	OBJ lStyleSymbol;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2028
	int lStyleInt;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2029
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2030
	lw= __intVal(lineWidthObj);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2031
	lStyleSymbol= lineStyleObj;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2032
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2033
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2034
	    only works with lineWidth = 1  */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2035
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2036
	if (lStyleSymbol == @symbol(solid)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2037
	    lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2038
	} else if (lStyleSymbol == @symbol(dashed)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2039
	    lStyleInt= PS_DASH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2040
	} else if (lStyleSymbol == @symbol(dotted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2041
	    lStyleInt= PS_DOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2042
	} else if (lStyleSymbol == @symbol(dashDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2043
	    lStyleInt= PS_DASHDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2044
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2045
	    lStyleInt= PS_DASHDOTDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2046
	} else if (lStyleSymbol == @symbol(insideFrame)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2047
	    lStyleInt= PS_INSIDEFRAME;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2048
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2049
	    lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2050
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2051
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2052
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2053
	num = __intVal(numberOfPoints);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2054
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2055
	for (i=0; i<num; i++) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2056
	    point = __AT_(aPolyline, __MKSMALLINT(i+1));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2057
	    if (! __isPoint(point)) goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2058
	    px = _point_X(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2059
	    py = _point_Y(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2060
	    if (! __bothSmallInteger(px, py)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2061
		goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2062
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2063
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2064
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2065
	hPen = CreatePen(lStyleInt, lw, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2066
	prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2067
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2068
	for (i=0; i<num; i++) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2069
	    point = __AT_(aPolyline, __MKSMALLINT(i+1));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2070
	    px = _point_X(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2071
	    py = _point_Y(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2072
	    p.x = __intVal(px);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2073
	    p.y = __intVal(py);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2074
	    DPRINTF(("printing point"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2075
	    DPRINTF(("displayPolygon: no pen\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2076
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2077
	    if ((i & 1) == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2078
		MoveToEx(hDC, p.x, p.y, NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2079
	    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2080
		LineTo(hDC, p.x, p.y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2081
		/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2082
		 * end-point ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2083
		 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2084
		LineTo(hDC, p.x+1, p.y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2085
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2086
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2087
	SelectObject(hDC, prevPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2088
	DeleteObject(hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2089
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2090
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2091
fail: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2092
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2093
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2094
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2095
displayRectangleX:x y:y width:width height:height in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2096
    "draw a rectangle. If the coordinates are not integers, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2097
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2098
    | lineWidthObj lineStyleObj |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2099
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2100
    lineWidthObj := self lineWidth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2101
	lineStyleObj := self lineStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2102
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2103
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2104
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2105
    int w, h;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2106
    int xL, yT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2107
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2108
     && __bothSmallInteger(x, y)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2109
     && __bothSmallInteger(width, height)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2110
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2111
	xL = __intVal(x);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2112
	yT = __intVal(y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2113
	w = __intVal(width);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2114
	h = __intVal(height);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2115
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2116
	DPRINTF(("displayRectangle: %d/%d -> %d/%d\n", xL, yT, w, h));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2117
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2118
	if ((w >= 0) && (h >= 0)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2119
	    HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2120
	    COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2121
	    HANDLE prevPen, hPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2122
	    OBJ lStyleSymbol;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2123
	    int lStyleInt;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2124
	    int lw;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2125
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2126
	    lw= __intVal(lineWidthObj);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2127
	    lStyleSymbol= lineStyleObj;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2128
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2129
	    /*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2130
		only works with lineWidth = 1  */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2131
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2132
	    if (lStyleSymbol == @symbol(solid)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2133
		lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2134
	    } else if (lStyleSymbol == @symbol(dashed)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2135
		lStyleInt= PS_DASH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2136
	    } else if (lStyleSymbol == @symbol(dotted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2137
		lStyleInt= PS_DOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2138
	    } else if (lStyleSymbol == @symbol(dashDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2139
		lStyleInt= PS_DASHDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2140
	    } else if (lStyleSymbol == @symbol(dashDotDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2141
		lStyleInt= PS_DASHDOTDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2142
	    } else if (lStyleSymbol == @symbol(insideFrame)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2143
		lStyleInt= PS_INSIDEFRAME;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2144
	    } else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2145
		lStyleInt= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2146
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2147
	    fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2148
	    hPen = CreatePen(lStyleInt, lw, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2149
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2150
	    prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2151
	    MoveToEx(hDC, xL, yT, NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2152
	    LineTo(hDC, xL+w, yT);       // to top-right
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2153
	    LineTo(hDC, xL+w, yT+h);     // to bot-right
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2154
	    MoveToEx(hDC, xL, yT, NULL); // back to top-left
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2155
	    LineTo(hDC, xL, yT+h);       // to bot-left
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2156
	    // LineTo(hDC, xL+w+1, yT+h);   // move pen one pixel more
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2157
	    LineTo(hDC, xL+w,   yT+h);   // move pen one pixel more
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2158
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2159
	    SelectObject(hDC, prevPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2160
	    DeleteObject(hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2161
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2162
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2163
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2164
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2165
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2166
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2167
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2168
    "Created: / 28-07-2006 / 20:18:25 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2169
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2170
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2171
displayRoundRectangleX:left y:top width:width height:height wCorner:wCorn hCorner:hCorn
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2172
    |right bottom wC hC wHalf hHalf|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2173
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2174
    right := left + width-1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2175
    bottom := top + height-1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2176
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2177
    wC := wCorn.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2178
    hC := hCorn.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2179
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2180
    self scale = 1 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2181
	wHalf := wC // 2.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2182
	hHalf := hC // 2.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2183
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2184
	wHalf := wC / 2.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2185
	hHalf := hC / 2.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2186
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2187
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2188
    "top left arc"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2189
    self displayArcX:left y:top width:wC height:hC from:90 angle:90.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2190
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2191
    "top right arc"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2192
    self displayArcX:(right - wC) y:top width:wC height:hC from:0 angle:90.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2193
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2194
    "bottom right arc"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2195
    self displayArcX:(right - wC) y:(bottom - hC) width:wC height:hC from:270 angle:90.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2196
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2197
    "bottom left arc"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2198
    self displayArcX:left y:(bottom - hC) width:wC height:hC from:180 angle:90.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2199
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2200
    "top line"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2201
    self displayLineFromX:(left + wHalf) y:top toX:(right - wHalf+1) y:top.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2202
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2203
    "left line"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2204
    self displayLineFromX:left y:(top + hHalf - 1) toX:left y:(bottom - hHalf).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2205
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2206
    "bottom line"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2207
    self displayLineFromX:(left + wHalf-1) y:bottom
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2208
		      toX:(right - wHalf ) y:bottom.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2209
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2210
    "right line"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2211
    self displayLineFromX:right y:(top + hHalf) toX:right y:(bottom - hHalf).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2212
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2213
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2214
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2215
     |v|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2216
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2217
     (v := View new) extent:200@200; openAndWait.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2218
     v displayRoundRectangleX:10 y:10 width:100 height:100 wCorner:20 hCorner:20
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2219
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2220
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2221
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2222
displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2223
    "draw a sub-string - draw foreground only.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2224
     If the coordinates are not integers, retry with rounded."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2225
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2226
    self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2227
	displayString:aString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2228
	from:index1
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2229
	to:index2
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2230
	x:x
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2231
	y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2232
	in:aDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2233
	with:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2234
	opaque:false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2235
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2236
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2237
displayString:aString from:index1 to:index2 x:x y:y in:ignoredDrawableId with:aDC opaque:opaque
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2238
    "draw a sub-string - if opaque is false, draw foreground only; otherwise, draw both
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2239
     foreground and background characters.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2240
     If the coordinates are not integers, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2241
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2242
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2243
    unsigned char *cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2244
    OBJ cls;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2245
    int  i1, i2, l, n;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2246
    int nInstBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2247
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2248
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2249
     && __isNonNilObject(aString)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2250
     && __bothSmallInteger(index1, index2)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2251
     && __bothSmallInteger(x, y))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2252
    {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2253
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2254
	int pX, pY;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2255
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2256
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2257
	pX = __intVal(x);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2258
	pY = __intVal(y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2259
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2260
	if (opaque == true) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2261
	    SetBkMode(hDC, OPAQUE);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2262
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2263
	    SetBkMode(hDC, TRANSPARENT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2264
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2265
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2266
	SetTextColor(hDC, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2267
	SetBkColor(hDC, 0xFFFFFFFF);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2268
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2269
	cls = __qClass(aString);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2270
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2271
	i1 = __intVal(index1) - 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2272
	if (i1 >= 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2273
	    i2 = __intVal(index2) - 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2274
	    if (i2 < i1) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2275
		goto ret;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2276
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2277
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2278
	    cp = __stringVal(aString);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2279
	    l = i2 - i1 + 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2280
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2281
	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2282
		n = __stringSize(aString);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2283
		if (i2 < n) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2284
		    cp += i1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2285
		    DPRINTF(("string1: %s pos=%d/%d l=%d hDC=%x\n", cp, pX, pY,l,hDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2286
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2287
		    if (l > 32767) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2288
			l = 32767;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2289
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2290
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2291
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2292
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2293
		    goto ret;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2294
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2295
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2296
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2297
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2298
	    cp += nInstBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2299
	    n = __byteArraySize(aString) - nInstBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2300
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2301
	    if (__isBytes(aString)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2302
		if (i2 < n) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2303
		    cp += i1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2304
		    DPRINTF(("string: %s pos=%d/%d\n", cp, pX, pY));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2305
		    if (l > 32767) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2306
			l = 32767;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2307
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2308
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2309
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2310
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2311
		    goto ret;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2312
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2313
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2314
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2315
	    /* Unicode */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2316
	    if (__isWords(aString)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2317
		n = n / 2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2318
		if (i2 < n) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2319
		    WIDECHAR *w_cp = (WIDECHAR *)cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2320
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2321
		    w_cp += i1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2322
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2323
		    if (! TextOutW(hDC, pX, pY, w_cp, l)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2324
			DFPRINTF((stderr, "WinPrinter [warning]: TextoutW failed. %d\n", GetLastError()));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2325
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2326
		    goto ret;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2327
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2328
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2329
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2330
ret:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2331
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2332
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2333
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2334
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2335
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2336
    "Created: / 28-07-2006 / 20:35:19 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2337
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2338
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2339
displayString:aString from:index1 to:index2 x:x y:y in:ignoredDrawableId with:aDC opaque:opaque fontAscent:fontAscent
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2340
    "draw a sub-string - if opaque is false, draw foreground only; otherwise, draw both
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2341
     foreground and background characters.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2342
     If the coordinates are not integers, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2343
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2344
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2345
    unsigned char *cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2346
    OBJ cls;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2347
    int  i1, i2, l, n;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2348
    int nInstBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2349
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2350
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2351
     && __isNonNilObject(aString)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2352
     && __bothSmallInteger(index1, index2)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2353
     && __bothSmallInteger(x, y))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2354
    {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2355
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2356
	int pX, pY;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2357
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2358
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2359
	pX = __intVal(x);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2360
	pY = __intVal(y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2361
	pY -= __intVal(fontAscent);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2362
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2363
	if (opaque == true) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2364
	    SetBkMode(hDC, OPAQUE);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2365
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2366
	    SetBkMode(hDC, TRANSPARENT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2367
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2368
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2369
	SetTextColor(hDC, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2370
	SetBkColor(hDC, 0xFFFFFFFF);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2371
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2372
	cls = __qClass(aString);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2373
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2374
	i1 = __intVal(index1) - 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2375
	if (i1 >= 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2376
	    i2 = __intVal(index2) - 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2377
	    if (i2 < i1) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2378
		goto ret;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2379
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2380
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2381
	    cp = __stringVal(aString);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2382
	    l = i2 - i1 + 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2383
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2384
	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2385
		n = __stringSize(aString);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2386
		if (i2 < n) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2387
		    cp += i1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2388
		    DPRINTF(("string1: %s pos=%d/%d l=%d hDC=%x\n", cp, pX, pY,l,hDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2389
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2390
		    if (l > 32767) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2391
			l = 32767;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2392
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2393
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2394
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2395
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2396
		    goto ret;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2397
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2398
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2399
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2400
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2401
	    cp += nInstBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2402
	    n = __byteArraySize(aString) - nInstBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2403
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2404
	    if (__isBytes(aString)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2405
		if (i2 < n) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2406
		    cp += i1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2407
		    DPRINTF(("string: %s pos=%d/%d\n", cp, pX, pY));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2408
		    if (l > 32767) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2409
			l = 32767;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2410
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2411
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2412
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2413
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2414
		    goto ret;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2415
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2416
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2417
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2418
	    /* Unicode */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2419
	    if (__isWords(aString)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2420
		n = n / 2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2421
		if (i2 < n) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2422
		    WIDECHAR *w_cp = (WIDECHAR *)cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2423
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2424
		    w_cp += i1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2425
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2426
		    if (! TextOutW(hDC, pX, pY, w_cp, l)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2427
			DFPRINTF((stderr, "WinPrinter [warning]: TextoutW failed. %d\n", GetLastError()));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2428
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2429
		    goto ret;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2430
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2431
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2432
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2433
ret:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2434
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2435
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2436
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2437
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2438
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2439
    "Created: / 28-07-2006 / 20:35:19 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2440
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2441
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2442
displayString:aString x:x y:y in:aDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2443
    "draw a string - draw foreground only.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2444
     If the coordinates are not integers, retry with rounded."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2445
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2446
    self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2447
	displayString:aString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2448
	x:x
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2449
	y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2450
	in:aDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2451
	with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2452
	opaque:false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2453
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2454
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2455
displayString:aString x:x y:y in:aDrawableId with:aDC opaque:opaque
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2456
    "draw a string"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2457
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2458
    self displayString:aString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2459
		  from:1
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2460
		    to:aString size
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2461
		     x:x
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2462
		     y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2463
		     in:aDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2464
		     with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2465
		     opaque:opaque
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2466
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2467
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2468
fillArcX:x y:y width:width height:height from:startAngle angle:angle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2469
	       in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2470
    "fill an arc. If any coordinate is not integer, an error is triggered.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2471
     The angles may be floats or integer - they are given in degrees."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2472
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2473
    | hatchSymbol |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2474
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2475
    hatchSymbol := self hatch.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2476
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2477
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2478
    int __x, __y, w, h;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2479
    float angle1, angle2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2480
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2481
    if (__isSmallInteger(startAngle))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2482
	angle1 = (float)(__intVal(startAngle));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2483
    else if (__isFloat(startAngle)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2484
	angle1 = __floatVal(startAngle);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2485
    } else if (__isShortFloat(startAngle)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2486
	angle1 = __shortFloatVal(startAngle);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2487
    } else goto bad;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2488
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2489
    if (__isSmallInteger(angle))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2490
	angle2 = (float)(__intVal(angle));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2491
    else if (__isFloat(angle)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2492
	angle2 = __floatVal(angle);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2493
    } else if (__isShortFloat(angle)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2494
	angle2 = __shortFloatVal(angle);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2495
    } else goto bad;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2496
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2497
    if (angle2 <= 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2498
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2499
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2500
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2501
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2502
     && __bothSmallInteger(x, y)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2503
     && __bothSmallInteger(width, height))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2504
     {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2505
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2506
	HBRUSH hBrush, prevBrush;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2507
	HPEN prevPen = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2508
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2509
	int hatch, hasHatch;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2510
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2511
	w = __intVal(width);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2512
	h = __intVal(height);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2513
	__x = __intVal(x);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2514
	__y = __intVal(y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2515
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2516
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2517
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2518
	hasHatch= 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2519
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2520
	if (hatchSymbol == @symbol(none)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2521
	    hasHatch= 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2522
	} else if (hatchSymbol == @symbol(horizontal)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2523
	    hatch= HS_HORIZONTAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2524
	} else if (hatchSymbol == @symbol(vertical)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2525
	    hatch= HS_VERTICAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2526
	} else if (hatchSymbol == @symbol(cross)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2527
	    hatch= HS_CROSS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2528
	} else if (hatchSymbol == @symbol(bDiagonal)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2529
	    hatch= HS_BDIAGONAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2530
	} else if (hatchSymbol == @symbol(fDiagonal)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2531
	    hatch= HS_FDIAGONAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2532
	} else if (hatchSymbol == @symbol(diagonalCross)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2533
	    hatch= HS_DIAGCROSS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2534
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2535
	    hasHatch= 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2536
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2537
	if (hasHatch) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2538
	    hBrush = CreateHatchBrush(hatch, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2539
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2540
	    hBrush = CreateSolidBrush(fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2541
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2542
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2543
	prevBrush = SelectObject(hDC, hBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2544
	if (hBrush == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2545
	    DPRINTF(("fillArc: no brush\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2546
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2547
	    HPEN hPen = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2548
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2549
	    if (0 /* __isWinNT */) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2550
		fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2551
		hPen = CreatePen(PS_SOLID, 1, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2552
		prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2553
		if (hPen == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2554
		    DPRINTF(("fillArc: no pen\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2555
		    goto failpen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2556
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2557
	    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2558
		prevPen = SelectObject(hDC, GetStockObject(NULL_PEN));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2559
		w++;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2560
		h++;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2561
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2562
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2563
	    {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2564
		double xB, yB, xE, yE, xR, yR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2565
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2566
		xR = w / 2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2567
		yR = h / 2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2568
		if (angle2 - angle1 >= 360) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2569
		    xB = xE = __x + xR + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2570
		    yB = yE = __y /*+ yR + 0.5*/;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2571
		} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2572
		    double sin(), cos();
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2573
		    float rad1, rad2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2574
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2575
		    if (angle1 <= 180)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2576
			angle1 = 180 - angle1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2577
		    else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2578
			angle1 = 360 + 180 - angle1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2579
		    angle2 = angle1 - angle2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2580
		    /* sigh - compute the intersections ... */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2581
		    rad1 = (angle1 * 3.14159265359) / 180.0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2582
		    rad2 = (angle2 * 3.14159265359) / 180.0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2583
		    xB = cos(rad1) * xR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2584
		    yB = sin(rad1) * yR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2585
		    xE = cos(rad2) * xR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2586
		    yE = sin(rad2) * yR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2587
		    xB = __x + xR - xB + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2588
		    yB = __y + yR - yB + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2589
		    xE = __x + xR - xE + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2590
		    yE = __y + yR - yE + 0.5;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2591
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2592
		DPRINTF(("fillArc x=%d y=%d w=%d h=%d xB=%d xE=%d yB=%d yE=%d a1=%f a2=%f\n",__x,__y,w,h,(int)xB,(int)xE,(int)yB,(int)yE,angle1,angle2));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2593
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2594
		Pie(hDC,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2595
		    __x, __y,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2596
		    __x + w + 1, __y + h + 1,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2597
		    (int)xB, (int)yB,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2598
		    (int)xE, (int)yE);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2599
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2600
		if (hPen) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2601
		    DeleteObject(hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2602
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2603
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2604
failpen:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2605
	    if (prevPen) SelectObject(hDC, prevPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2606
	    DeleteObject(hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2607
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2608
	    SelectObject(hDC, prevBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2609
	    DeleteObject(hBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2610
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2611
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2612
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2613
    bad: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2614
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2615
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2616
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2617
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2618
fillPolygon:aPolygon in:ignoredDrawableId with:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2619
    "fill a polygon given by its points.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2620
     If any coordinate is not integer, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2621
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2622
    |numberOfPoints|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2623
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2624
    numberOfPoints := aPolygon size.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2625
    self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2626
	primFillPolygon:aPolygon n:numberOfPoints
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2627
	in:ignoredDrawableId with:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2628
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2629
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2630
fillRectangleX:x y:y width:width height:height in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2631
    "fill a rectangle. If any coordinate is not integer, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2632
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2633
    |hatchSymbol|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2634
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2635
    hatchSymbol := self hatch.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2636
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2637
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2638
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2639
    int w, h;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2640
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2641
     && __bothSmallInteger(x, y)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2642
     && __bothSmallInteger(width, height)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2643
	w = __intVal(width);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2644
	h = __intVal(height);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2645
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2646
	if ((w >= 0) && (h >= 0)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2647
	    HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2648
	    HBRUSH hBrush, prevBrush;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2649
	    RECT rct;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2650
	    COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2651
	    int hatch, hasHatch;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2652
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2653
	    fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2654
	    hasHatch= 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2655
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2656
	    if (hatchSymbol == @symbol(none)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2657
		hasHatch= 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2658
	    } else if (hatchSymbol == @symbol(horizontal)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2659
		hatch= HS_HORIZONTAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2660
	    } else if (hatchSymbol == @symbol(vertical)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2661
		hatch= HS_VERTICAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2662
	    } else if (hatchSymbol == @symbol(cross)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2663
		hatch= HS_CROSS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2664
	    } else if (hatchSymbol == @symbol(bDiagonal)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2665
		hatch= HS_BDIAGONAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2666
	    } else if (hatchSymbol == @symbol(fDiagonal)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2667
		hatch= HS_FDIAGONAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2668
	    } else if (hatchSymbol == @symbol(diagonalCross)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2669
		hatch= HS_DIAGCROSS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2670
	    } else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2671
		hasHatch= 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2672
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2673
	    if (hasHatch) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2674
		hBrush = CreateHatchBrush(hatch, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2675
	    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2676
		hBrush = CreateSolidBrush(fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2677
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2678
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2679
	    rct.left = __intVal(x);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2680
	    rct.top  = __intVal(y);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2681
	    rct.right  = rct.left + w; // + 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2682
	    rct.bottom = rct.top  + h; // + 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2683
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2684
	   prevBrush = SelectObject(hDC, hBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2685
	   FillRect(hDC, &rct, hBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2686
	   SelectObject(hDC, prevBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2687
	   DeleteObject(hBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2688
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2689
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2690
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2691
    RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2692
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2693
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2694
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2695
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2696
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2697
primFillPolygon:aPolygon n:numberOfPoints in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2698
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2699
    |hatchSymbol|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2700
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2701
    hatchSymbol := self hatch.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2702
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2703
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2704
    OBJ point, px, py;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2705
    int i, num;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2706
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2707
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2708
     && __isSmallInteger(numberOfPoints)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2709
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2710
	POINT p;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2711
	HBRUSH hBrush, prevBrush;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2712
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2713
	int hatch, hasHatch;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2714
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2715
	num = __intVal(numberOfPoints);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2716
	if (num < 3) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2717
	    RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2718
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2719
	for (i=0; i<num; i++) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2720
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2721
	    if (! __isPoint(point)) goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2722
	    px = _point_X(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2723
	    py = _point_Y(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2724
	    if (! __bothSmallInteger(px, py))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2725
		goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2726
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2727
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2728
	fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2729
	hasHatch= 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2730
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2731
	if (hatchSymbol == @symbol(none)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2732
	    hasHatch= 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2733
	} else if (hatchSymbol == @symbol(horizontal)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2734
	    hatch= HS_HORIZONTAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2735
	} else if (hatchSymbol == @symbol(vertical)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2736
	    hatch= HS_VERTICAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2737
	} else if (hatchSymbol == @symbol(cross)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2738
	    hatch= HS_CROSS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2739
	} else if (hatchSymbol == @symbol(bDiagonal)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2740
	    hatch= HS_BDIAGONAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2741
	} else if (hatchSymbol == @symbol(fDiagonal)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2742
	    hatch= HS_FDIAGONAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2743
	} else if (hatchSymbol == @symbol(diagonalCross)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2744
	    hatch= HS_DIAGCROSS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2745
	} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2746
	    hasHatch= 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2747
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2748
	if (hasHatch) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2749
	    hBrush = CreateHatchBrush(hatch, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2750
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2751
	    hBrush = CreateSolidBrush(fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2752
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2753
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2754
	if (hBrush == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2755
	    DPRINTF(("fillPolygon: no brush\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2756
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2757
	    HPEN prevPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2758
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2759
	    prevBrush = SelectObject(hDC, hBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2760
	    prevPen = SelectObject(hDC, GetStockObject(NULL_PEN));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2761
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2762
	    BeginPath(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2763
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2764
	    for (i=0; i<num; i++) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2765
		point = __AT_(aPolygon, __MKSMALLINT(i+1));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2766
		px = _point_X(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2767
		py = _point_Y(point);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2768
		if (i == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2769
		    MoveToEx(hDC, __intVal(px), __intVal(py), NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2770
		} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2771
		    if (i == (num-1)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2772
			p.x = __intVal(px);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2773
			p.y = __intVal(py);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2774
			PolylineTo(hDC, &p, 1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2775
		    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2776
			LineTo(hDC, __intVal(px), __intVal(py));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2777
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2778
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2779
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2780
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2781
	    EndPath(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2782
	    FillPath(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2783
	    SelectObject(hDC, prevPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2784
	    SelectObject(hDC, prevBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2785
	    DeleteObject(hBrush);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2786
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2787
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2788
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2789
fail: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2790
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2791
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2792
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2793
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2794
scaleTest_displayString:aString x:x y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2795
    "draw a string at the coordinate x/y -
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2796
     draw foreground-pixels only (in current paint-color),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2797
     leaving background as-is. If the transformation involves scaling,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2798
     the fonts point-size is scaled as appropriate."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2799
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2800
    |id pX pY fontUsed sz s fontsEncoding|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2801
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2802
    "hook for non-strings (i.e. attributed text)"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2803
    (aString isString not
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2804
    or:[aString isText]) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2805
	^ aString displayOn:self x:x y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2806
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2807
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2808
    self gcId isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2809
	self initGC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2810
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2811
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2812
    fontUsed := self font.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2813
    self transformation notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2814
	pX := self transformation applyToX:x.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2815
	pY := self transformation applyToY:y.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2816
	self transformation noScale ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2817
	    sz := self font size.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2818
	    sz isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2819
		"/ oops - not a real font; use original font
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2820
		fontUsed := self font.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2821
	    ] ifFalse:[ |yS|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2822
		yS := self pixelsPerInchOfScreenHeight / Screen current verticalPixelPerInch.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2823
		yS := self scale y / yS.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2824
		fontUsed := self font size:(sz * yS) rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2825
	    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2826
	]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2827
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2828
	pX := x.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2829
	pY := y.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2830
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2831
    pX := pX rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2832
    pY := pY rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2833
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2834
    s := aString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2835
    fontUsed := fontUsed onDevice:self device.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2836
    fontsEncoding := fontUsed encoding.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2837
    (self characterEncoding ~~ fontsEncoding) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2838
	[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2839
	    s := CharacterEncoder encodeString:s from:self characterEncoding into:fontsEncoding.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2840
	] on:CharacterEncoderError do:[:ex|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2841
	    "substitute a default value for codes that cannot be represented
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2842
	     in the new character set"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2843
	    ex proceedWith:ex defaultValue.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2844
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2845
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2846
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2847
    id := fontUsed fontId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2848
    id isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2849
	"hook for alien fonts"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2850
	fontUsed displayString:s x:x y:y in:self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2851
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2852
	self deviceFont ~~ fontUsed ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2853
	    self device setFont:id in:self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2854
	    self deviceFont: fontUsed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2855
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2856
	self device displayString:s x:pX y:pY in:self drawableId with:self gcId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2857
    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2858
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2859
    "Modified: 1.7.1997 / 17:08:35 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2860
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2861
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2862
!WinPrinterContext methodsFor:'drawing bitmaps'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2863
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2864
bitsBlue
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2865
    "return the number of valid bits in the red component."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2866
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2867
"/    bitsRed isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2868
"/        "/ not a truecolor display
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2869
"/        ^ bitsPerRGB
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2870
"/    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2871
"/    ^ bitsRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2872
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2873
     ^Display bitsBlue
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2874
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2875
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2876
bitsGreen
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2877
    "return the number of valid bits in the red component."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2878
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2879
"/    bitsRed isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2880
"/        "/ not a truecolor display
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2881
"/        ^ bitsPerRGB
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2882
"/    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2883
"/    ^ bitsRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2884
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2885
     ^Display bitsGreen
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2886
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2887
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2888
bitsRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2889
    "return the number of valid bits in the red component."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2890
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2891
"/    bitsRed isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2892
"/        "/ not a truecolor display
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2893
"/        ^ bitsPerRGB
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2894
"/    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2895
"/    ^ bitsRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2896
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2897
     ^Display bitsRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2898
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2899
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2900
compressColorMapImage: image
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2901
    "calculates a new color map for the image, using only used colors"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2902
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2903
    |depth newColorMap newImage oldImage usedColors oldToNew oldBits newBits tmpBits|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2904
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2905
    oldImage := image.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2906
    depth := oldImage depth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2907
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2908
    oldImage photometric ~~ #palette ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2909
	Transcript showCR:'Compress colorMap: Only palette images have colormaps.'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2910
	^ image
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2911
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2912
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2913
    usedColors := oldImage realUsedColors.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2914
    usedColors size == (1 bitShift:depth) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2915
	Transcript showCR:'Compress colorMap: All colors are used - no compression.'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2916
	^ image
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2917
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2918
    usedColors size == oldImage colorMap size ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2919
	Transcript showCR:'Compress colorMap: Colormap already compressed - no compression.'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2920
	^ image
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2921
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2922
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2923
	"/ translation table
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2924
	oldToNew := ByteArray new:(1 bitShift:depth).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2925
	newColorMap := usedColors asArray.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2926
	newColorMap sort:self sortBlockForColors.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2927
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2928
	oldImage colorMap asArray keysAndValuesDo:[:oldIdx :clr |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2929
	    |newPixel|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2930
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2931
	    (usedColors includes:clr) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2932
		newPixel := newColorMap indexOf:clr.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2933
		oldToNew at:oldIdx put:newPixel-1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2934
	    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2935
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2936
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2937
	oldBits := oldImage bits.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2938
	newBits := ByteArray new:(oldBits size).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2939
	depth ~~ 8 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2940
	    "/ expand/compress can only handle 8bits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2941
	    tmpBits := ByteArray uninitializedNew:(oldImage width*oldImage height).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2942
	    oldBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2943
		expandPixels:depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2944
		width:oldImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2945
		height:oldImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2946
		into:tmpBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2947
		mapping:oldToNew.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2948
	    tmpBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2949
		compressPixels:depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2950
		width:oldImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2951
		height:oldImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2952
		into:newBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2953
		mapping:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2954
	] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2955
	    oldBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2956
		expandPixels:depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2957
		width:oldImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2958
		height:oldImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2959
		into:newBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2960
		mapping:oldToNew.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2961
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2962
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2963
	newImage := oldImage species new
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2964
			width:oldImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2965
			height:oldImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2966
			depth:depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2967
			fromArray:newBits.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2968
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2969
	newImage colorMap:newColorMap.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2970
	newImage fileName:oldImage fileName.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2971
	newImage mask:(oldImage mask copy).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2972
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2973
	^ newImage
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2974
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2975
    "Created: / 28.7.1998 / 20:03:11 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2976
    "Modified: / 15.9.1998 / 17:53:32 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2977
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2978
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2979
copyFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2980
		width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2981
    "do a bit-blt; copy bits from the rectangle defined by
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2982
     srcX/srcY and w/h from the sourceId drawable to the rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2983
     below dstX/dstY in the destId drawable. Trigger an error if any
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2984
     argument is not integer."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2985
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2986
     | function |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2987
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2988
     function := self function.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2989
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2990
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2991
    int     dstGcOwnerThreadID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2992
    HWND    dstGcHWIN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2993
    HBITMAP dstGcHBITMAP;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2994
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2995
    if (! __isExternalAddressLike(srcGCId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2996
     || ! __isExternalAddressLike(dstGCId)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2997
	goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2998
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  2999
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3000
    if (__bothSmallInteger(w, h)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3001
     && __bothSmallInteger(srcX, srcY)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3002
     && __bothSmallInteger(dstX, dstY)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3003
	HANDLE srcDC = (HANDLE)(__externalAddressVal(srcGCId));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3004
	HANDLE dstDC = (HANDLE)(__externalAddressVal(dstGCId));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3005
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3006
	int fun;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3007
	OBJ aFunctionSymbol;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3008
	int src_fg, src_bg, dst_fg, dst_bg;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3009
	char buf[5];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3010
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3011
//          fun = dstGcData->bitbltrop2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3012
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3013
	aFunctionSymbol= function;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3014
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3015
	if (aFunctionSymbol == @symbol(copy)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3016
	    fun = SRCCOPY /* R2_COPYPEN */ ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3017
/*            bfun = BITBLT_COPY;                                          */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3018
	} else if (aFunctionSymbol == @symbol(copyInverted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3019
	    fun = NOTSRCCOPY /* R2_NOTCOPYPEN */;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3020
/*            bfun = BITBLT_COPYINVERTED;                                  */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3021
	} else if (aFunctionSymbol == @symbol(xor)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3022
	    fun = SRCINVERT /* R2_XORPEN */;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3023
/*            bfun = BITBLT_XOR;                                           */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3024
	} else if (aFunctionSymbol == @symbol(and)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3025
	    fun = SRCAND /* R2_MASKPEN */ ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3026
/*            bfun = BITBLT_AND;                                           */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3027
	} else if (aFunctionSymbol == @symbol(or)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3028
	    fun = MERGECOPY /* R2_MERGEPEN */ ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3029
/*            bfun = BITBLT_OR;                                            */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3030
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3031
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3032
    // convert 123 to string [buf]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3033
    // itoa(fun, buf, 10);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3034
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3035
    //        console_printf(" ", buf);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3036
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3037
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3038
#if 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3039
	switch (fun) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3040
	  case BITBLT_COPY:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3041
	    console_printf("BITBLT_COPY\n");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3042
	    break;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3043
	  case BITBLT_COPYINVERTED:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3044
	    console_printf("BITBLT_COPYINVERTED\n");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3045
	    break;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3046
	  case BITBLT_XOR:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3047
	    console_printf("BITBLT_XOR\n");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3048
	    break;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3049
	  case BITBLT_AND:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3050
	    console_printf("BITBLT_AND\n");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3051
	    break;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3052
	  case BITBLT_OR:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3053
	    console_printf("BITBLT_OR\n");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3054
	    break;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3055
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3056
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3057
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3058
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3059
//          fun = dstGcData->bitbltrop2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3060
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3061
	if (0 /* fun == BITBLT_COPY */) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3062
	    src_fg = dst_fg = 0xFFFFFF;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3063
	    src_bg = dst_bg = 0x000000;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3064
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3065
	    src_fg = GetTextColor(srcDC) /* srcGcData->fgColor */;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3066
	    src_bg = GetBkColor(dstDC) /* srcGcData->bgColor */;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3067
	    dst_fg = GetTextColor(srcDC) /* dstGcData->fgColor */;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3068
	    dst_bg = GetBkColor(dstDC) /* dstGcData->bgColor */;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3069
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3070
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3071
	SetBkColor(dstDC, dst_fg);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3072
	SetTextColor(dstDC, dst_bg);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3073
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3074
	SetBkColor(srcDC, src_fg);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3075
	SetTextColor(srcDC, src_bg);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3076
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3077
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3078
	CPRINTF(("bitblt src f:%x b:%x",GetTextColor(srcDC),GetBkColor(srcDC)));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3079
	CPRINTF(("dst f:%x b:%x\n",GetTextColor(dstDC),GetBkColor(dstDC)));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3080
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3081
	if (BitBlt(dstDC,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3082
	     __intVal(dstX), __intVal(dstY),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3083
	     __intVal(w), __intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3084
	     srcDC,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3085
	     __intVal(srcX), __intVal(srcY),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3086
	     fun)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3087
	   == 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3088
	  ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3089
	    console_fprintf(stderr, "WinWorkstation [info]: ERROR in BitBlt\n");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3090
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3091
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3092
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3093
	if (dstGcData != srcGcData) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3094
	    SetBkColor(dstDC, dstGcData->bgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3095
	    SetTextColor(dstDC, dstGcData->fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3096
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3097
	SetBkColor(srcDC, srcGcData->bgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3098
	SetTextColor(srcDC, srcGcData->fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3099
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3100
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3101
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3102
	if (srcGcData != dstGcData) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3103
	    _releaseDC(srcGcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3104
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3105
	_releaseDC(dstGcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3106
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3107
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3108
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3109
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3110
 fail: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3111
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3112
    self primitiveFailed.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3113
    ^ nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3114
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3115
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3116
copyFromPixmapId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3117
    "do a bit-blt from a pix- or bitmap.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3118
     Here, fall back into copyFromId:, which should also work.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3119
     Subclasses may redefine this for more performance or if required"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3120
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3121
    ^ self copyFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3122
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3123
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3124
copyPlaneFromId:sourceId x:srcX y:srcY gc:srcDCId to:destId x:dstX y:dstY gc:dstDCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3125
		width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3126
    "do a bit-blt, but only copy the low-bit plane;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3127
     copy bits from the rectangle defined by
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3128
     srcX/srcY and w/h from the sourceId drawable to the rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3129
     below dstX/dstY in the destId drawable. Trigger an error if any
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3130
     argument is not integer."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3131
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3132
    ^ self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3133
	copyFromId:sourceId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3134
		 x:srcX y:srcY gc:srcDCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3135
		to:destId x:dstX y:dstY gc:dstDCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3136
	     width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3137
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3138
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3139
copyPlaneFromPixmapId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3140
    "do a bit-blt from a pix- or bitmap, using the low-bit plane of the source only.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3141
     Here, fall back into copyPlaneFromId:, which should also work.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3142
     Subclasses may redefine this for more performance or if required"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3143
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3144
    ^ self copyPlaneFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3145
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3146
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3147
createBitmapFromArray:anArray width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3148
    |bitmapId|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3149
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3150
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3151
    bitmapId := self primCreateBitmapFromArray:anArray width:w height:h.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3152
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3153
    bitmapId isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3154
	'WINWORKSTATION: cannot create bitmap' errorPrintCR.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3155
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3156
    ^ bitmapId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3157
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3158
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3159
createPixmapWidth:w height:h depth:d
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3160
    "allocate a pixmap on the Xserver, the contents is undefined
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3161
     (i.e. random). Return a bitmap id or nil"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3162
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3163
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3164
    HANDLE newBitmapHandle;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3165
    HANDLE rootDC = CreateDC("DISPLAY", NULL, NULL, NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3166
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3167
    /*console_printf("CreateBitmap Color\n");*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3168
    if (__bothSmallInteger(w, h) && __isSmallInteger(d) /*&& ISCONNECTED */) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3169
	if (__intVal(d) == 1) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3170
	    newBitmapHandle = CreateBitmap(__intVal(w), __intVal(h) , 1, 1, NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3171
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3172
#if 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3173
	    if (__intVal(d) != __depth) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3174
		console_printf("invalid depth\n");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3175
		RETURN (nil);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3176
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3177
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3178
	    newBitmapHandle = CreateCompatibleBitmap(rootDC, __intVal(w), __intVal(h) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3179
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3180
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3181
	if (newBitmapHandle) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3182
	    RETURN ( __MKEXTERNALADDRESS(newBitmapHandle));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3183
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3184
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3185
	DPRINTF(("empty bitmap handle = %x\n", newBitmapHandle));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3186
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3187
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3188
    RETURN (nil);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3189
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3190
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3191
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3192
destroyPixmap:aDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3193
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3194
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3195
    if (__isExternalAddress(aDrawableId) /* && ISCONNECTED */ ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3196
	HANDLE bitmapHandle = _HANDLEVal(aDrawableId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3197
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3198
	if (bitmapHandle) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3199
	    DeleteObject(bitmapHandle);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3200
	/*    _DeleteObject(bitmapHandle, __LINE__);    */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3201
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3202
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3203
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3204
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3205
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3206
displayDeviceForm:aForm x:x y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3207
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3208
    |sortedImage formMask bitsWithTransparency redVector greenVector blueVector|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3209
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3210
    sortedImage := aForm.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3211
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3212
    "Image 16 bits"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3213
    aForm depth = 16 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3214
	bitsWithTransparency := aForm bits.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3215
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3216
    "Image 24 and 32 bits"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3217
    aForm depth >= 24 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3218
	|bestFormat|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3219
	bestFormat := aForm bestSupportedImageFormatFor: Display.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3220
	bitsWithTransparency := aForm rgbImageBitsOn: Display bestFormat: bestFormat.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3221
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3222
    "Image up to 8 bits"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3223
    aForm depth <= 8 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3224
	aForm depth < 8 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3225
	    sortedImage := aForm asImageWithDepth: 8.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3226
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3227
"/        sortedImage := self sortColorMapImage: aForm.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3228
	sortedImage := self compressColorMapImage: sortedImage.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3229
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3230
	formMask := sortedImage mask.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3231
	formMask isNil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3232
	    ifTrue:[bitsWithTransparency := sortedImage bits ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3233
	    ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3234
		|bitsWithTransparencySize|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3235
		formMask := formMask asImageWithDepth: sortedImage depth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3236
		bitsWithTransparency := sortedImage bits copy.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3237
		bitsWithTransparencySize := bitsWithTransparency size.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3238
		formMask bits doWithIndex:[:maskBit :index |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3239
		    bitsWithTransparencySize >= index ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3240
			maskBit == 0 ifTrue:[bitsWithTransparency at: index put: 255 "60" "bitClearAt: index"].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3241
"/                    maskBit == 1 ifTrue:[bitsWithTransparency at: index put: (bitsWithTransparency at: index)].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3242
		    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3243
		].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3244
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3245
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3246
	redVector := sortedImage colorMap redVector.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3247
	greenVector := sortedImage colorMap greenVector.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3248
	blueVector := sortedImage colorMap blueVector.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3249
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3250
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3251
    self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3252
	 drawBits: bitsWithTransparency
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3253
	redVector: redVector
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3254
      greenVector: greenVector
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3255
       blueVector: blueVector
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3256
     bitsPerPixel: sortedImage bitsPerPixel
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3257
	    depth: sortedImage depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3258
	    width: sortedImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3259
	   height: sortedImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3260
	     into: self id
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3261
		x: x
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3262
		y: y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3263
	    width: sortedImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3264
	   height: sortedImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3265
	     with: self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3266
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3267
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3268
drawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3269
			  width:imageWidth height:imageHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3270
			      x:srcx y:srcy
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3271
			   into:ignoredDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3272
			      x:dstx y:dsty
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3273
			  width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3274
			   with:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3275
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3276
    "draw a bitImage which has depth id, width iw and height ih into
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3277
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3278
     Individual source pixels have bitsPerPixel bits, allowing to draw
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3279
     depth and pixel-units to be different.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3280
     It has to be checked elsewhere, that the server can do it with the given
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3281
     depth - otherwise, primitive failure will be signalled.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3282
     Also it is assumed, that the colormap is setup correctly and the
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3283
     colors are allocated - otherwise the colors may be wrong."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3284
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3285
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3286
     sorry; I had to separate it into 2 methods, since XPutImage needs
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3287
     an unlimited stack, and thus cannot send primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3288
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3289
    (self primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3290
					width:imageWidth height:imageHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3291
					     x:srcx y:srcy
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3292
					  into:ignoredDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3293
					     x:(dstx rounded) y:(dsty rounded)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3294
					 width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3295
					  with:aGCId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3296
    ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3297
	"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3298
	 also happens, if a segmentation violation occurs in the
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3299
	 XPutImage ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3300
	"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3301
	self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3302
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3303
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3304
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3305
drawBits:imageBits redVector:redVector greenVector:greenVector blueVector:blueVector bitsPerPixel:bitsPerPixel depth:imageDepth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3306
			      width:imageWidth height:imageHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3307
			       into:ignoredDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3308
				  x:dstx y:dsty
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3309
			      width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3310
			       with:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3311
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3312
    "draw a bitImage which has depth id, width iw and height ih into
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3313
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3314
     Individual source pixels have bitsPerPixel bits, allowing to draw
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3315
     depth and pixel-units to be different.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3316
     It has to be checked elsewhere, that the server can do it with the given
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3317
     depth - otherwise, primitive failure will be signalled.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3318
     Also it is assumed, that the colormap is setup correctly and the
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3319
     colors are allocated - otherwise the colors may be wrong."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3320
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3321
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3322
     sorry; I had to separate it into 2 methods, since XPutImage needs
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3323
     an unlimited stack, and thus cannot send primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3324
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3325
    (self primDrawBits:imageBits redVector:redVector greenVector:greenVector blueVector:blueVector bitsPerPixel:bitsPerPixel depth:imageDepth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3326
			      width:imageWidth height:imageHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3327
			       into:ignoredDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3328
				  x:(dstx rounded) y:(dsty rounded)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3329
			      width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3330
			       with:aGCId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3331
    ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3332
	self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3333
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3334
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3335
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3336
primCreateBitmapFromArray:anArray width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3337
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3338
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3339
    HBITMAP newBitmapHandle;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3340
    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3341
    int row, col;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3342
    unsigned char *cp, *bPits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3343
    unsigned char *b_bits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3344
    int index;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3345
    OBJ num;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3346
    unsigned char *allocatedBits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3347
    unsigned char fastBits[10000];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3348
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3349
    if (__bothSmallInteger(w, h)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3350
     && __isNonNilObject(anArray)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3351
	OBJ cls = __qClass(anArray);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3352
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3353
	b_width = __intVal(w);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3354
	b_height = __intVal(h);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3355
	bytesPerRowST = (b_width + 7) / 8;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3356
	bytesPerRowWN = ((b_width + 15) / 16) * 2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3357
	padding = bytesPerRowWN - bytesPerRowST;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3358
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3359
	if ((padding == 0) && (cls == @global(ByteArray))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3360
	    b_bits = __ByteArrayInstPtr(anArray)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3361
	    cp = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3362
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3363
	    int nBytes = b_height * bytesPerRowWN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3364
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3365
	    if (nBytes < sizeof(fastBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3366
		cp = b_bits = fastBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3367
	    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3368
		cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3369
		if (! cp) goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3370
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3371
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3372
	if (cp) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3373
	    if (__qIsArrayLike(anArray)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3374
		OBJ *op;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3375
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3376
		index = 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3377
		op = &(__ArrayInstPtr(anArray)->a_element[index - 1]);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3378
		for (row = b_height; row; row--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3379
		    for (col = bytesPerRowST; col; col--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3380
			num = *op++;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3381
			if (! __isSmallInteger(num))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3382
			    goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3383
			*cp++ = __intVal(num);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3384
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3385
		    cp += padding;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3386
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3387
	    } else if (__qIsByteArrayLike(anArray)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3388
		unsigned char *pBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3389
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3390
		pBits = __ByteArrayInstPtr(anArray)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3391
		for (row = b_height; row; row--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3392
		    for (col = bytesPerRowST; col; col--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3393
			*cp++ = ( *pBits++ /*^ 0xFF*/ );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3394
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3395
		    cp += padding;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3396
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3397
	    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3398
		goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3399
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3400
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3401
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3402
	CPRINTF(("create bitmap ...\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3403
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3404
	newBitmapHandle = CreateBitmap(b_width, b_height, 1, 1, b_bits );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3405
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3406
	if (newBitmapHandle ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3407
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3408
	    DDPRINTF(("returning bitmap %x ...\n", newBitmapHandle));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3409
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3410
	    if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3411
		free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3412
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3413
	    RETURN ( __MKEXTERNALADDRESS(newBitmapHandle));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3414
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3415
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3416
fail: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3417
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3418
    DDPRINTF(("create bitmap FAILED!!!\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3419
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3420
    if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3421
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3422
	CPRINTF(("freeing up bitmap bits ...\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3423
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3424
	free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3425
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3426
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3427
    CPRINTF(("returning nil ...\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3428
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3429
    RETURN ( nil );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3430
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3431
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3432
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3433
primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3434
			      width:imageWidth height:imageHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3435
				  x:srcx y:srcy
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3436
			       into:ignoredDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3437
				  x:dstx y:dsty
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3438
			      width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3439
			       with:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3440
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3441
    "since XPutImage may allocate huge amount of stack space
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3442
     (some implementations use alloca), this must run with unlimited stack."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3443
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3444
    | drawableId |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3445
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3446
    drawableId := self drawableId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3447
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3448
    unsigned char fastBits[10000];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3449
    unsigned char *b_bits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3450
    unsigned char *allocatedBits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3451
    unsigned char *__imageBits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3452
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3453
    if (__isByteArray(imageBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3454
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3455
    } else if (__isExternalBytesLike(imageBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3456
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3457
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3458
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3459
    if (/* ISCONNECTED
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3460
     && */ __isExternalAddressLike(aGCId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3461
     && __bothSmallInteger(srcx, srcy)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3462
     && __bothSmallInteger(dstx, dsty)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3463
     && __bothSmallInteger(w, h)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3464
     && __bothSmallInteger(imageWidth, imageHeight)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3465
     && __bothSmallInteger(imageDepth, bitsPerPixel)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3466
     && __isSmallInteger(padd)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3467
     && __imageBits)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3468
     {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3469
	struct
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3470
	{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3471
	  BITMAPINFOHEADER bmiHeader;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3472
	  DWORD r;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3473
	  DWORD g;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3474
	  DWORD b;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3475
	} bitmap;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3476
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3477
	HANDLE hDC = (HANDLE)(__externalAddressVal(aGCId));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3478
	HBITMAP hBitmap = _HBITMAPVAL(drawableId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3479
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3480
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3481
	DDPRINTF(("hDC = %x\n", hDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3482
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3483
	if (__intVal(padd) != WIN32PADDING) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3484
	    int row, col;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3485
	    unsigned char *cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3486
	    unsigned char *pBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3487
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3488
	    int bi = __intVal(bitsPerPixel);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3489
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3490
	    b_width = __intVal(w);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3491
	    b_height = __intVal(h);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3492
	    bytesPerRowST = (b_width * bi + (__intVal(padd)-1)) / __intVal(padd);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3493
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3494
	    padding = bytesPerRowWN - bytesPerRowST;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3495
	    nBytes = b_height * bytesPerRowWN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3496
	    /*console_printf("padd %d bs %d bw %d p %d\n",__intVal(padd),bytesPerRowST,bytesPerRowWN,padding);*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3497
	    if (padding) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3498
		if (nBytes < sizeof(fastBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3499
		    cp = b_bits = fastBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3500
		} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3501
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3502
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3503
		if (cp) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3504
		    pBits = __imageBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3505
		    for (row = b_height; row; row--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3506
			for (col = bytesPerRowST; col; col--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3507
			    *cp++ = *pBits++;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3508
			}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3509
			cp += padding;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3510
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3511
		} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3512
		    goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3513
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3514
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3515
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3516
	if (b_bits == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3517
	    b_bits = __imageBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3518
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3519
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3520
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3521
	bitmap.bmiHeader.biPlanes = 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3522
	if (__intVal(imageDepth) == 24) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3523
	    /*bitmap.bmiHeader.biCompression = BI_BITFIELDS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3524
	    bitmap.r = 0xff0000;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3525
	    bitmap.g = 0x00ff00;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3526
	    bitmap.b = 0x0000ff;*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3527
	    bitmap.bmiHeader.biCompression = BI_RGB;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3528
	} else if (__intVal(imageDepth) == 16) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3529
	    /*bitmap.bmiHeader.biCompression = BI_RGB;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3530
	    bitmap.bmiHeader.biCompression = BI_BITFIELDS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3531
	    bitmap.b = 0x001f;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3532
	    bitmap.g = 0x07e0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3533
	    bitmap.r = 0xf800;*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3534
	    bitmap.b = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3535
	    bitmap.g = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3536
	    bitmap.r = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3537
	    bitmap.bmiHeader.biCompression = BI_RGB;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3538
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3539
	bitmap.bmiHeader.biSizeImage = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3540
	bitmap.bmiHeader.biXPelsPerMeter = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3541
	bitmap.bmiHeader.biYPelsPerMeter = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3542
	bitmap.bmiHeader.biClrUsed = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3543
	bitmap.bmiHeader.biClrImportant = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3544
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3545
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3546
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3547
	/*console_printf("drawBits depth:%d bitsPerPixel:%d IW%d W:%d H:%d\n",__intVal(imageDepth),bitmap.bmiHeader.biBitCount,bitmap.bmiHeader.biWidth,__intVal(w),bitmap.bmiHeader.biHeight);*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3548
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3549
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3550
			      __intVal(w), __intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3551
			      __intVal(srcx), __intVal(srcy),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3552
			      0,__intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3553
			      (void *)b_bits,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3554
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3555
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3556
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3557
	SetDIBits(hDC,hBitmap,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3558
			      0,__intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3559
			      (void *)b_bits,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3560
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3561
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3562
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3563
	StretchDIBits(hDC,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3564
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3565
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3566
		      __intVal(srcx), __intVal(srcy),           // x & y coord of source upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3567
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3568
		      (void *)b_bits,                           // bitmap bits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3569
		      (BITMAPINFO*)&bitmap,                     // bitmap data
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3570
		      DIB_RGB_COLORS,                           // usage options
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3571
		      SRCCOPY                                   // raster operation code
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3572
	);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3573
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3574
	if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3575
	    free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3576
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3577
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3578
#ifndef CACHE_LAST_DC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3579
	_releaseDC(gcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3580
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3581
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3582
	RETURN ( true );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3583
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3584
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3585
fail: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3586
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3587
    PRINTF(("create temp bitmap FAILED!!!\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3588
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3589
    if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3590
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3591
	PRINTF(("freeing up temp bitmap bits ...\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3592
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3593
	free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3594
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3595
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3596
#ifndef CACHE_LAST_DC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3597
    if (hDC) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3598
	_releaseDC(gcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3599
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3600
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3601
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3602
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3603
.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3604
    ^ false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3605
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3606
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3607
primDrawBits:imageBits redVector:redVector greenVector:greenVector blueVector:blueVector bitsPerPixel:bitsPerPixel depth:imageDepth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3608
			      width:imageWidth height:imageHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3609
			       into:ignoredDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3610
				  x:dstx y:dsty
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3611
			      width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3612
			       with:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3613
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3614
    "since XPutImage may allocate huge amount of stack space
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3615
     (some implementations use alloca), this must run with unlimited stack."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3616
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3617
    | drawableId |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3618
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3619
    drawableId := self drawableId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3620
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3621
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3622
    unsigned char fastBits[10000];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3623
    unsigned char *b_bits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3624
    unsigned char *allocatedBits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3625
    unsigned char *__imageBits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3626
    unsigned char *__redVector = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3627
    unsigned char *__greenVector = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3628
    unsigned char *__blueVector = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3629
    int padd = 8;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3630
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3631
    if (__isByteArray(imageBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3632
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3633
    } else if (__isExternalBytesLike(imageBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3634
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3635
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3636
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3637
    if (__isByteArray(redVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3638
	__redVector = __ByteArrayInstPtr(redVector)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3639
    } else if (__isExternalBytesLike(redVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3640
	__redVector = (unsigned char *)(__externalBytesAddress(redVector));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3641
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3642
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3643
    if (__isByteArray(greenVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3644
	__greenVector = __ByteArrayInstPtr(greenVector)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3645
    } else if (__isExternalBytesLike(greenVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3646
	__greenVector = (unsigned char *)(__externalBytesAddress(greenVector));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3647
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3648
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3649
    if (__isByteArray(blueVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3650
	__blueVector = __ByteArrayInstPtr(blueVector)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3651
    } else if (__isExternalBytesLike(blueVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3652
	__blueVector = (unsigned char *)(__externalBytesAddress(blueVector));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3653
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3654
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3655
    if (/* ISCONNECTED
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3656
     && */ __isExternalAddressLike(aGCId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3657
//     && __bothSmallInteger(srcx, srcy)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3658
     && __bothSmallInteger(dstx, dsty)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3659
     && __bothSmallInteger(w, h)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3660
     && __bothSmallInteger(imageWidth, imageHeight)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3661
     && __bothSmallInteger(imageDepth, bitsPerPixel)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3662
     && __imageBits)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3663
     {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3664
	struct
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3665
	{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3666
	  BITMAPINFOHEADER bmiHeader;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3667
	  RGBQUAD bmiColors[256];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3668
	} bitmap;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3669
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3670
	HANDLE hDC = (HANDLE)(__externalAddressVal(aGCId));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3671
	HBITMAP hBitmap = _HBITMAPVAL(drawableId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3672
	int col;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3673
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3674
	DDPRINTF(("hDC = %x\n", hDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3675
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3676
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3677
	if (padd != WIN32PADDING) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3678
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3679
	    int row, col;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3680
	    unsigned char *cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3681
	    unsigned char *pBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3682
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3683
	    int bi = __intVal(bitsPerPixel);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3684
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3685
//            console_fprintf(stderr, "Non WIN32PADDING");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3686
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3687
	    b_width = __intVal(w);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3688
	    b_height = __intVal(h);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3689
	    bytesPerRowST = (b_width * bi + (padd - 1 )) / padd;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3690
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3691
	    padding = bytesPerRowWN - bytesPerRowST;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3692
	    nBytes = b_height * bytesPerRowWN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3693
	    /*console_printf("padd %d bs %d bw %d p %d\n",__intVal(padd),bytesPerRowST,bytesPerRowWN,padding);*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3694
	    if (padding) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3695
		if (nBytes < sizeof(fastBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3696
		    cp = b_bits = fastBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3697
		} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3698
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3699
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3700
		if (cp) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3701
		    pBits = __imageBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3702
		    for (row = b_height; row; row--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3703
			for (col = bytesPerRowST; col; col--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3704
			    *cp++ = *pBits++;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3705
			}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3706
			cp += padding;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3707
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3708
		} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3709
		    goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3710
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3711
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3712
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3713
	if (b_bits == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3714
	    b_bits = __imageBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3715
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3716
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3717
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3718
	bitmap.bmiHeader.biPlanes = 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3719
	bitmap.bmiHeader.biCompression = BI_RGB;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3720
	bitmap.bmiHeader.biSizeImage = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3721
	bitmap.bmiHeader.biXPelsPerMeter = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3722
	bitmap.bmiHeader.biYPelsPerMeter = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3723
	bitmap.bmiHeader.biClrUsed = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3724
	bitmap.bmiHeader.biClrImportant = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3725
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3726
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3727
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3728
	/*console_printf("drawBits depth:%d bitsPerPixel:%d IW%d W:%d H:%d\n",__intVal(imageDepth),bitmap.bmiHeader.biBitCount,bitmap.bmiHeader.biWidth,__intVal(w),bitmap.bmiHeader.biHeight);*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3729
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3730
	if (__intVal(imageDepth) <= 8) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3731
	    for(col=0;col<256;col++)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3732
	     {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3733
	      bitmap.bmiColors[col].rgbBlue = __blueVector[col];    // Microsoft idea: change rgbBlue to rgbRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3734
	      bitmap.bmiColors[col].rgbGreen = __greenVector[col];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3735
	      bitmap.bmiColors[col].rgbRed = __redVector[col];         // Microsoft idea: change rgbRed to rgbBlue
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3736
	      bitmap.bmiColors[col].rgbReserved = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3737
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3738
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3739
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3740
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3741
	bitmap.bmiColors[255].rgbBlue=255;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3742
	bitmap.bmiColors[255].rgbGreen=255;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3743
	bitmap.bmiColors[255].rgbRed =255;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3744
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3745
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3746
			      __intVal(w), __intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3747
			      0, 0, /* __intVal(srcx), __intVal(srcy),    */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3748
			      0,__intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3749
			      (void *)b_bits,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3750
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3751
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3752
	SetDIBits(hDC,hBitmap,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3753
			      0,__intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3754
			      (void *)b_bits,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3755
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3756
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3757
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3758
	StretchDIBits(hDC,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3759
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3760
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3761
		      __intVal(srcx), __intVal(srcy),           // x & y coord of source upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3762
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3763
		      (void *)b_bits,                           // bitmap bits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3764
		      (BITMAPINFO*)&bitmap,                     // bitmap data
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3765
		      DIB_RGB_COLORS,                           // usage options
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3766
		      SRCCOPY                                   // raster operation code
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3767
	);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3768
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3769
	if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3770
	    free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3771
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3772
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3773
#ifndef CACHE_LAST_DC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3774
	_releaseDC(gcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3775
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3776
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3777
	RETURN ( true );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3778
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3779
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3780
fail: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3781
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3782
    PRINTF(("create temp bitmap FAILED!!!\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3783
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3784
    if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3785
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3786
	PRINTF(("freeing up temp bitmap bits ...\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3787
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3788
	free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3789
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3790
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3791
#ifndef CACHE_LAST_DC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3792
    if (hDC) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3793
	_releaseDC(gcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3794
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3795
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3796
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3797
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3798
.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3799
    ^ false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3800
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3801
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3802
setFunction:aFunctionSymbol in:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3803
    "set alu function to be drawn with"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3804
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3805
    Transcript showCR: aFunctionSymbol printString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3806
    self function: aFunctionSymbol.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3807
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3808
"/%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3809
"/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3810
"/    if (__isExternalAddress(aGCId)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3811
"/        struct gcData *gcData = _GCDATA(aGCId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3812
"/        int fun = -1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3813
"/        int bfun = -1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3814
"/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3815
"/        if (aFunctionSymbol == @symbol(copy)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3816
"/            fun = R2_COPYPEN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3817
"/            bfun = BITBLT_COPY;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3818
"/        } else if (aFunctionSymbol == @symbol(copyInverted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3819
"/            fun = R2_NOTCOPYPEN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3820
"/            bfun = BITBLT_COPYINVERTED;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3821
"/        } else if (aFunctionSymbol == @symbol(xor)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3822
"/            fun = R2_XORPEN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3823
"/            bfun = BITBLT_XOR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3824
"/        } else if (aFunctionSymbol == @symbol(and)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3825
"/            fun = R2_MASKPEN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3826
"/            bfun = BITBLT_AND;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3827
"/        } else if (aFunctionSymbol == @symbol(or)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3828
"/            fun = R2_MERGEPEN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3829
"/            bfun = BITBLT_OR;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3830
"/        }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3831
"/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3832
"/        if (fun
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3833
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3834
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3835
setGraphicsExposures:aBoolean in:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3836
    "set or clear the graphics exposures flag"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3837
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3838
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3839
shiftBlue
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3840
    "return the number of valid bits in the red component."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3841
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3842
"/    bitsRed isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3843
"/        "/ not a truecolor display
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3844
"/        ^ bitsPerRGB
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3845
"/    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3846
"/    ^ bitsRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3847
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3848
     ^Display shiftBlue
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3849
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3850
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3851
shiftGreen
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3852
    "return the number of valid bits in the red component."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3853
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3854
"/    bitsRed isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3855
"/        "/ not a truecolor display
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3856
"/        ^ bitsPerRGB
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3857
"/    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3858
"/    ^ bitsRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3859
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3860
     ^Display shiftGreen
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3861
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3862
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3863
shiftRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3864
    "return the number of valid bits in the red component."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3865
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3866
"/    bitsRed isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3867
"/        "/ not a truecolor display
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3868
"/        ^ bitsPerRGB
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3869
"/    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3870
"/    ^ bitsRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3871
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3872
     ^Display shiftRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3873
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3874
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3875
sortBlockForColors
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3876
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3877
    ^ [:a :b |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3878
	    a redByte == b redByte ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3879
		a greenByte == b greenByte ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3880
		    a blueByte < b blueByte
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3881
		] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3882
		    a greenByte < b greenByte
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3883
		]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3884
	    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3885
		a redByte < b redByte
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3886
	    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3887
      ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3888
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3889
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3890
sortColorMapImage: image
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3891
    "calculates a new color map for the image, sorting colors"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3892
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3893
    |sortBlock depth newColorMap newImage oldImage usedColors oldToNew oldBits newBits tmpBits|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3894
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3895
    sortBlock := self sortBlockForColors.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3896
    oldImage := image.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3897
    depth := oldImage depth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3898
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3899
    oldImage photometric ~~ #palette ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3900
	Transcript showCR:'Compress colorMap: Only palette images have colormaps.'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3901
	^ image
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3902
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3903
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3904
    usedColors := oldImage realColorMap.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3905
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3906
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3907
	"/ translation table
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3908
	oldToNew := ByteArray new:(1 bitShift:depth).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3909
	newColorMap := usedColors asArray.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3910
	newColorMap sort:sortBlock.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3911
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3912
	oldImage colorMap asArray keysAndValuesDo:[:oldIdx :clr |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3913
	    |newPixel|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3914
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3915
	    (usedColors includes:clr) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3916
		newPixel := newColorMap indexOf:clr.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3917
		oldToNew at:oldIdx put:newPixel-1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3918
	    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3919
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3920
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3921
	oldBits := oldImage bits.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3922
	newBits := ByteArray new:(oldBits size).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3923
	depth ~~ 8 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3924
	    "/ expand/compress can only handle 8bits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3925
	    tmpBits := ByteArray uninitializedNew:(oldImage width*oldImage height).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3926
	    oldBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3927
		expandPixels:depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3928
		width:oldImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3929
		height:oldImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3930
		into:tmpBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3931
		mapping:oldToNew.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3932
	    tmpBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3933
		compressPixels:depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3934
		width:oldImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3935
		height:oldImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3936
		into:newBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3937
		mapping:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3938
	] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3939
	    oldBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3940
		expandPixels:depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3941
		width:oldImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3942
		height:oldImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3943
		into:newBits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3944
		mapping:oldToNew.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3945
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3946
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3947
	newImage := oldImage species new
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3948
			width:oldImage width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3949
			height:oldImage height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3950
			depth:depth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3951
			fromArray:newBits.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3952
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3953
	newImage colorMap:newColorMap.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3954
	newImage fileName:oldImage fileName.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3955
	newImage mask:(oldImage mask copy).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3956
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3957
	^newImage
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3958
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3959
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3960
transparencyTest_primDrawBits:imageBits redVector:redVector greenVector:greenVector blueVector:blueVector bitsPerPixel:bitsPerPixel depth:imageDepth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3961
			      width:imageWidth height:imageHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3962
			       into:ignoredDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3963
				  x:dstx y:dsty
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3964
			      width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3965
			       with:aGCId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3966
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3967
    "since XPutImage may allocate huge amount of stack space
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3968
     (some implementations use alloca), this must run with unlimited stack."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3969
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3970
    | drawableId |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3971
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3972
    drawableId := self drawableId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3973
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3974
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3975
    unsigned char fastBits[10000];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3976
    unsigned char *b_bits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3977
    unsigned char *allocatedBits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3978
    unsigned char *__imageBits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3979
    unsigned char *__redVector = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3980
    unsigned char *__greenVector = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3981
    unsigned char *__blueVector = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3982
    int padd = 8;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3983
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3984
    if (__isByteArray(imageBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3985
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3986
    } else if (__isExternalBytesLike(imageBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3987
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3988
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3989
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3990
    if (__isByteArray(redVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3991
	__redVector = __ByteArrayInstPtr(redVector)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3992
    } else if (__isExternalBytesLike(redVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3993
	__redVector = (unsigned char *)(__externalBytesAddress(redVector));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3994
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3995
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3996
    if (__isByteArray(greenVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3997
	__greenVector = __ByteArrayInstPtr(greenVector)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3998
    } else if (__isExternalBytesLike(greenVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  3999
	__greenVector = (unsigned char *)(__externalBytesAddress(greenVector));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4000
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4001
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4002
    if (__isByteArray(blueVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4003
	__blueVector = __ByteArrayInstPtr(blueVector)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4004
    } else if (__isExternalBytesLike(blueVector)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4005
	__blueVector = (unsigned char *)(__externalBytesAddress(blueVector));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4006
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4007
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4008
    if (/* ISCONNECTED
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4009
     && */ __isExternalAddressLike(aGCId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4010
//     && __bothSmallInteger(srcx, srcy)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4011
     && __bothSmallInteger(dstx, dsty)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4012
     && __bothSmallInteger(w, h)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4013
     && __bothSmallInteger(imageWidth, imageHeight)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4014
     && __bothSmallInteger(imageDepth, bitsPerPixel)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4015
     && __imageBits)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4016
     {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4017
	struct
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4018
	{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4019
	  BITMAPINFOHEADER bmiHeader;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4020
	  RGBQUAD bmiColors[256];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4021
	} bitmap;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4022
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4023
	HANDLE hDC = (HANDLE)(__externalAddressVal(aGCId));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4024
	HBITMAP hBitmap = _HBITMAPVAL(drawableId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4025
	int col;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4026
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4027
	DDPRINTF(("hDC = %x\n", hDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4028
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4029
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4030
	if (padd != WIN32PADDING) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4031
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4032
	    int row, col;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4033
	    unsigned char *cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4034
	    unsigned char *pBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4035
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4036
	    int bi = __intVal(bitsPerPixel);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4037
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4038
//            console_fprintf(stderr, "Non WIN32PADDING");
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4039
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4040
	    b_width = __intVal(w);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4041
	    b_height = __intVal(h);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4042
	    bytesPerRowST = (b_width * bi + (padd - 1 )) / padd;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4043
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4044
	    padding = bytesPerRowWN - bytesPerRowST;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4045
	    nBytes = b_height * bytesPerRowWN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4046
	    /*console_printf("padd %d bs %d bw %d p %d\n",__intVal(padd),bytesPerRowST,bytesPerRowWN,padding);*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4047
	    if (padding) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4048
		if (nBytes < sizeof(fastBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4049
		    cp = b_bits = fastBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4050
		} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4051
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4052
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4053
		if (cp) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4054
		    pBits = __imageBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4055
		    for (row = b_height; row; row--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4056
			for (col = bytesPerRowST; col; col--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4057
			    *cp++ = *pBits++;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4058
			}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4059
			cp += padding;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4060
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4061
		} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4062
		    goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4063
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4064
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4065
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4066
	if (b_bits == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4067
	    b_bits = __imageBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4068
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4069
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4070
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4071
	bitmap.bmiHeader.biPlanes = 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4072
	bitmap.bmiHeader.biCompression = BI_RGB;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4073
	bitmap.bmiHeader.biSizeImage = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4074
	bitmap.bmiHeader.biXPelsPerMeter = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4075
	bitmap.bmiHeader.biYPelsPerMeter = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4076
	bitmap.bmiHeader.biClrUsed = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4077
	bitmap.bmiHeader.biClrImportant = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4078
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4079
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4080
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4081
	/*console_printf("drawBits depth:%d bitsPerPixel:%d IW%d W:%d H:%d\n",__intVal(imageDepth),bitmap.bmiHeader.biBitCount,bitmap.bmiHeader.biWidth,__intVal(w),bitmap.bmiHeader.biHeight);*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4082
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4083
	if (__intVal(imageDepth) <= 8) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4084
	    for(col=0;col<256;col++)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4085
	     {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4086
	      bitmap.bmiColors[col].rgbBlue = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4087
	      bitmap.bmiColors[col].rgbGreen = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4088
	      bitmap.bmiColors[col].rgbRed = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4089
	      bitmap.bmiColors[col].rgbReserved = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4090
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4091
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4092
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4093
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4094
	bitmap.bmiColors[255].rgbBlue=255;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4095
	bitmap.bmiColors[255].rgbGreen=255;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4096
	bitmap.bmiColors[255].rgbRed =255;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4097
	bitmap.bmiColors[255].rgbReserved = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4098
	StretchDIBits(hDC,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4099
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4100
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4101
		      0, 0,  /* __intVal(srcx), __intVal(srcy),    */   // x & y coord of source upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4102
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4103
		      (void *)b_bits,                           // bitmap bits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4104
		      (BITMAPINFO*)&bitmap,                     // bitmap data
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4105
		      DIB_RGB_COLORS,                           // usage options
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4106
		      SRCAND                                   // raster operation code
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4107
	);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4108
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4109
	if (__intVal(imageDepth) <= 8) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4110
	    for(col=0;col<256;col++)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4111
	     {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4112
	      bitmap.bmiColors[col].rgbBlue = __blueVector[col];    // Microsoft idea: change rgbBlue to rgbRed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4113
	      bitmap.bmiColors[col].rgbGreen = __greenVector[col];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4114
	      bitmap.bmiColors[col].rgbRed = __redVector[col];         // Microsoft idea: change rgbRed to rgbBlue
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4115
	      bitmap.bmiColors[col].rgbReserved = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4116
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4117
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4118
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4119
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4120
	bitmap.bmiColors[255].rgbBlue=0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4121
	bitmap.bmiColors[255].rgbGreen=0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4122
	bitmap.bmiColors[255].rgbRed =0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4123
	bitmap.bmiColors[255].rgbReserved = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4124
	StretchDIBits(hDC,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4125
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4126
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4127
		      0, 0,                                     // x & y coord of source upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4128
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4129
		      (void *)b_bits,                           // bitmap bits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4130
		      (BITMAPINFO*)&bitmap,                     // bitmap data
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4131
		      DIB_RGB_COLORS,                           // usage options
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4132
		      SRCPAINT                                  // raster operation code
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4133
	);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4134
 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4135
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4136
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4137
			      __intVal(w), __intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4138
			      0, 0,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4139
			      0,__intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4140
			      (void *)b_bits,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4141
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4142
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4143
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4144
	SetDIBits(hDC,hBitmap,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4145
			      0,__intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4146
			      (void *)b_bits,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4147
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4148
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4149
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4150
	StretchDIBits(hDC,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4151
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4152
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4153
		      __intVal(srcx), __intVal(srcy),           // x & y coord of source upper-left corner
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4154
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4155
		      (void *)b_bits,                           // bitmap bits
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4156
		      (BITMAPINFO*)&bitmap,                     // bitmap data
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4157
		      DIB_RGB_COLORS,                           // usage options
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4158
		      SRCCOPY                                   // raster operation code
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4159
	);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4160
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4161
	if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4162
	    free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4163
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4164
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4165
#ifndef CACHE_LAST_DC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4166
	_releaseDC(gcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4167
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4168
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4169
	RETURN ( true );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4170
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4171
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4172
fail: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4173
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4174
    PRINTF(("create temp bitmap FAILED!!!\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4175
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4176
    if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4177
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4178
	PRINTF(("freeing up temp bitmap bits ...\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4179
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4180
	free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4181
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4182
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4183
#ifndef CACHE_LAST_DC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4184
    if (hDC) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4185
	_releaseDC(gcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4186
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4187
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4188
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4189
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4190
.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4191
    ^ false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4192
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4193
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4194
!WinPrinterContext methodsFor:'font stuff'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4195
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4196
createFontFor:aFontName
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4197
    "a basic method for font allocation; this method allows
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4198
     any font to be acquired (even those not conforming to
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4199
     standard naming conventions, such as cursor, fixed or k14)"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4200
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4201
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4202
    HGDIOBJ hFont;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4203
    char *fn;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4204
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4205
    if (__isStringLike(aFontName)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4206
	fn = __stringVal(aFontName);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4207
	if ((strcmp(fn, "fixed") == 0) || (strcmp(fn, "ANSI_FIXED_FONT") == 0)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4208
	    hFont = GetStockObject(ANSI_FIXED_FONT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4209
	} else if ((strcmp(fn, "variable") == 0) || (strcmp(fn, "ANSI_VAR_FONT") == 0)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4210
	    hFont = GetStockObject(ANSI_VAR_FONT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4211
	} else if ((strcmp(fn, "system") == 0) || (strcmp(fn, "SYSTEM_FONT") == 0)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4212
	    hFont = GetStockObject(SYSTEM_FONT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4213
	} else if ((strcmp(fn, "systemFixed") == 0) || (strcmp(fn, "SYSTEM_FIXED_FONT") == 0)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4214
	    hFont = GetStockObject(SYSTEM_FIXED_FONT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4215
	} else if ((strcmp(fn, "deviceDefault") == 0) || (strcmp(fn, "DEVICE_DEFAULT_FONT") == 0)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4216
	    hFont = GetStockObject(DEVICE_DEFAULT_FONT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4217
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4218
	    hFont = GetStockObject(ANSI_FIXED_FONT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4219
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4220
	if (hFont) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4221
	    DPRINTF(("createFontFor:%s -> %x\n", fn, hFont));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4222
	    RETURN ( __MKEXTERNALADDRESS(hFont) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4223
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4224
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4225
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4226
    ^ nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4227
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4228
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4229
fontMetricsOf:fontId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4230
    "return a fonts metrics info object"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4231
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4232
    |rawData info|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4233
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4234
    rawData := Array new:15.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4235
    (self primFontMetricsOf:fontId hdc:self gcId intoArray:rawData) isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4236
	self primitiveFailed.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4237
	^ self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4238
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4239
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4240
    rawData at:11 put:#'ms-ansi'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4241
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4242
    info := DeviceWorkstation::DeviceFontMetrics new.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4243
    info
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4244
      ascent:(rawData at:1)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4245
      descent:(rawData at:2)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4246
      maxAscent:(rawData at:3)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4247
      maxDescent:(rawData at:4)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4248
      minWidth:(rawData at:5)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4249
      maxWidth:(rawData at:6)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4250
      avgWidth:(rawData at:7)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4251
      minCode:(rawData at:8)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4252
      maxCode:16rFFFF "(rawData at:9)"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4253
      direction:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4254
      encoding:(rawData at:11).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4255
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4256
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4257
    ^ info
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4258
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4259
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4260
getDefaultFontWithEncoding:encoding
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4261
    "return a default font id - used when class Font cannot
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4262
     find anything usable"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4263
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4264
     ^ self createFontFor:'fixed'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4265
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4266
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4267
getFontWithFamily:familyString face:faceString style:styleString size:sizeArg encoding:encodingSym
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4268
    "try to get the specified font, return id.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4269
     If not available, try next smaller font.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4270
     If no font fits, return nil"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4271
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4272
    ^ self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4273
	getFontWithFamily:familyString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4274
	face:faceString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4275
	style:styleString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4276
	size:sizeArg
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4277
	sizeUnit:#pt
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4278
	encoding:encodingSym
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4279
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4280
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4281
getFontWithFamily:familyString face:faceString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4282
	    style:styleArgString size:sizeArgOrNil sizeUnit:sizeUnit encoding:encodingSym
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4283
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4284
    "try to get the specified font, if not available, try the next smaller
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4285
     font."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4286
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4287
    |styleString theName theId xlatedStyle id spacing|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4288
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4289
    self assert:(sizeUnit == #pt).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4290
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4291
    styleString := styleArgString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4292
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4293
    "special: if face is nil, allow access to X-fonts"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4294
    faceString isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4295
	sizeArgOrNil notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4296
	    theName := familyString , '-' , sizeArgOrNil printString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4297
	] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4298
	    theName := familyString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4299
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4300
	theName notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4301
	    theId := self createFontFor:theName.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4302
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4303
	theId isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4304
	    theId := self getDefaultFontWithEncoding:encodingSym
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4305
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4306
	^ theId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4307
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4308
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4309
    "/ spacing other than 'normal' is contained as last component
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4310
    "/ in style
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4311
    styleString notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4312
	((styleString endsWith:'-narrow')
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4313
	 or:[styleString endsWith:'-semicondensed']) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4314
	    |i|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4315
	    i := styleString lastIndexOf:$-.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4316
	    spacing := styleString copyFrom:(i+1).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4317
	    styleString := styleString copyTo:(i-1).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4318
	] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4319
	    spacing := 'normal'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4320
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4321
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4322
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4323
    xlatedStyle := styleString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4324
    xlatedStyle notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4325
	xlatedStyle := xlatedStyle first asString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4326
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4327
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4328
    id := self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4329
	    getFontWithFoundry:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4330
	    family:familyString asLowercase
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4331
	    weight:faceString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4332
	    slant:styleString "/ xlatedStyle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4333
	    spacing:spacing
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4334
	    pixelSize:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4335
	    size:sizeArgOrNil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4336
	    registry:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4337
	    encoding:encodingSym.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4338
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4339
    id isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4340
	(encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4341
	    "/ too stupid: encodings come in both cases
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4342
	    "/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4343
	    id := self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4344
		    getFontWithFoundry:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4345
		    family:familyString asLowercase
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4346
		    weight:faceString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4347
		    slant:styleString "/ xlatedStyle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4348
		    spacing:spacing
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4349
		    pixelSize:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4350
		    size:sizeArgOrNil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4351
		    registry:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4352
		    encoding:encodingSym asUppercase.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4353
	    id isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4354
		id := self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4355
			getFontWithFoundry:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4356
			family:familyString asLowercase
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4357
			weight:faceString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4358
			slant:styleString "/ xlatedStyle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4359
			spacing:spacing
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4360
			pixelSize:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4361
			size:sizeArgOrNil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4362
			registry:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4363
			encoding:encodingSym asLowercase.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4364
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4365
		id isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4366
		    id := self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4367
			    getFontWithFoundry:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4368
			    family:familyString asLowercase
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4369
			    weight:faceString asLowercase
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4370
			    slant:styleString asLowercase
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4371
			    spacing:spacing
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4372
			    pixelSize:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4373
			    size:sizeArgOrNil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4374
			    registry:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4375
			    encoding:encodingSym asLowercase.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4376
		]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4377
	    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4378
	]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4379
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4380
    ^ id
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4381
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4382
    "Modified: 24.2.1996 / 22:37:24 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4383
    "Modified: 4.7.1996 / 11:38:47 / stefan"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4384
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4385
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4386
getFontWithFoundry:foundry family:family weight:weight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4387
	      slant:slant spacing:spc pixelSize:pixelSize size:pointSize
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4388
	      registry:registry encoding:encodingArg
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4389
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4390
    "get the specified font, if not available, return nil.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4391
     For now, this is a poor (incomplete) emulation of the X code ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4392
     Individual attributes can be left empty (i.e. '') or nil to match any.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4393
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4394
     foundry:   'adobe', 'misc', 'dec', 'schumacher' ... usually '*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4395
     family:    'helvetica' 'courier' 'times' ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4396
     weight:    'bold' 'medium' 'demi' ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4397
     slant:     'r(oman)' 'i(talic)' 'o(blique)'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4398
     spacing:   'narrow' 'normal' semicondensed' ... usually '*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4399
     pixelSize: 16,18 ... usually left empty
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4400
     size:      size in point (1/72th of an inch)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4401
     registry:  iso8859, sgi ... '*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4402
     encoding:  vendor specific encoding (usually '*')
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4403
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4404
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4405
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4406
     Windows-NT/95 allows the creation of a font with the following parameters
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4407
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4408
	nHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4409
	nWidth
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4410
	nEscapement
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4411
	nOrientation
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4412
	fnWeight        FW_DONTCARE, FW_NORMAL, FW_MEDIUM, FW_BOLD, ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4413
	fdwItalic       TRUE or FALSE
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4414
	fdwUnderline    TRUE or FALSE
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4415
	fdwStrikeOut    TRUE or FALSE
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4416
	fdwCharSet      ANSI_CHARSET, UNICODE_, SYMBOL_, SHIFTJIS_,...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4417
	fdwOutputPrecision      DEFAULT, STRING, CHAR, ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4418
	fdwClipPrecision        DEFAULT, CHAR, STROKE, MASK, ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4419
	fdwQuality      DEFAULT, DRAFT, or PROOF.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4420
	fdwPitchAndFamily
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4421
		DEFAULT, FIXED or VARIABLE pitch
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4422
		DECORATIVE, DONTCASE, MODERN, ROMAN, SCRIPT, or SWISS.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4423
	lpszFace
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4424
		Typeface Name
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4425
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4426
      These two above descriptions will be matched as follows:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4427
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4428
	foundry   - ignored
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4429
	family    - mapped to type face name.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4430
	weight    - mapped to fnWeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4431
	slant     - used for style
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4432
	spacing   - NOT USED INITIALLY
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4433
	pixelSize - NOT USED INITIALLY
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4434
	size      - mapped to nHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4435
	registry  - NOT USED INITIALLY
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4436
	encoding  - mapped to fdwCharSet
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4437
     "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4438
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4439
    |logSize encoding|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4440
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4441
    encoding := encodingArg asSymbol.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4442
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4443
    pixelSize notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4444
	logSize := pixelSize
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4445
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4446
	logSize := (pointSize * (self getLogicalPixelSizeY) / 72.0) rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4447
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4448
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4449
    HGDIOBJ hFont;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4450
    int  nHeight, nWidth, nEscapement, nOrientation;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4451
    char* work;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4452
    char* work2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4453
    DWORD fnWeight;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4454
    DWORD fdwItalic;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4455
    DWORD fdwUnderline;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4456
    DWORD fdwStrikeOut;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4457
    DWORD fdwCharSet;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4458
    DWORD fdwOutputPrecision;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4459
    DWORD fdwClipPrecision;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4460
    DWORD fdwQuality;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4461
    DWORD fdwPitchAndFamily;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4462
    static char faceName[256];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4463
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4464
/* INITIALIZE */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4465
    strcpy( faceName, "NULL" );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4466
    nHeight   = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4467
    nWidth   = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4468
    nEscapement = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4469
    nOrientation = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4470
    fnWeight = FW_NORMAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4471
    fdwItalic = FALSE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4472
    fdwUnderline = FALSE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4473
    fdwStrikeOut = FALSE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4474
    fdwOutputPrecision = OUT_DEFAULT_PRECIS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4475
    fdwClipPrecision   = CLIP_DEFAULT_PRECIS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4476
    fdwQuality         = DEFAULT_QUALITY;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4477
    fdwPitchAndFamily  = FF_DONTCARE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4478
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4479
    fdwCharSet   = ANSI_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4480
    if ((encoding == @symbol('ms-ansi'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4481
	fdwCharSet   = ANSI_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4482
    } else if (encoding == @symbol('ms-default')
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4483
	       || encoding == @symbol(*)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4484
	fdwCharSet   = DEFAULT_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4485
    } else if ((encoding == @symbol('ms-symbol'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4486
	    || (encoding == @symbol('misc-fontspecific'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4487
	fdwCharSet   = SYMBOL_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4488
    } else if ((encoding == @symbol('ms-shiftjis'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4489
	    || (encoding == @symbol('jisx0208.1983-0'))){
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4490
	fdwCharSet   = SHIFTJIS_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4491
    } else if ((encoding == @symbol('ms-gb2312'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4492
	    || (encoding == @symbol('gb2312.1980-0'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4493
	fdwCharSet   = GB2312_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4494
    } else if ((encoding == @symbol('ms-hangeul'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4495
	    || (encoding == @symbol('ksc5601.1987-0'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4496
	fdwCharSet   = HANGEUL_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4497
    } else if ((encoding == @symbol('ms-chinesebig5'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4498
	    || (encoding == @symbol('big5'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4499
	fdwCharSet   = CHINESEBIG5_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4500
    } else if (encoding == @symbol('ms-oem')) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4501
	fdwCharSet   = OEM_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4502
    } else if (encoding == @symbol('ms-johab')) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4503
	fdwCharSet   = JOHAB_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4504
    } else if ((encoding == @symbol('ms-hebrew'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4505
	    || (encoding == @symbol('ms-cp1255'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4506
	fdwCharSet   = HEBREW_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4507
    } else if ((encoding == @symbol('ms-arabic'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4508
	    || (encoding == @symbol('ms-cp1256'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4509
	fdwCharSet   = ARABIC_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4510
    } else if ((encoding == @symbol('ms-greek'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4511
	    || (encoding == @symbol('ms-cp1253'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4512
	fdwCharSet   = GREEK_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4513
    } else if ((encoding == @symbol('ms-turkish'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4514
	    || (encoding == @symbol('ms-cp1254'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4515
	fdwCharSet   = TURKISH_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4516
    } else if ((encoding == @symbol('ms-russian'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4517
	    || (encoding == @symbol('ms-cp1251'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4518
	fdwCharSet   = RUSSIAN_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4519
    } else if ((encoding == @symbol('ms-easteurope'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4520
	    || (encoding == @symbol('ms-cp1250'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4521
	fdwCharSet   = EASTEUROPE_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4522
    } else if ((encoding == @symbol('ms-baltic'))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4523
	    || (encoding == @symbol('ms-cp1257'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4524
	fdwCharSet   = BALTIC_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4525
    } else if ((encoding == @symbol('ms-vietnamese'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4526
	fdwCharSet   = VIETNAMESE_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4527
    } else if ((encoding == @symbol('ms-thai'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4528
	fdwCharSet   = THAI_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4529
    } else if ((encoding == @symbol('ms-mac'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4530
	fdwCharSet   = MAC_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4531
#ifdef UNICODE_CHARSET
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4532
    } else if ((encoding == @symbol('ms-unicode'))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4533
	fdwCharSet   = UNICODE_CHARSET;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4534
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4535
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4536
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4537
    if ( __isString( family ) ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4538
	work = __stringVal( family );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4539
	if (strcmp( work, "nil" ) != 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4540
	    strncpy( faceName, work, sizeof(faceName)-1 );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4541
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4542
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4543
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4544
    /* Q: should we allow those ? (they make ST/X programs less portable to X */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4545
    if( __isString( weight ) ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4546
	work = __stringVal( weight );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4547
	if (strcmp( work, "bold" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4548
	    fnWeight = FW_BOLD;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4549
	} else if (strcmp( work, "medium" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4550
	    fnWeight = FW_MEDIUM;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4551
	} else if (strcmp( work, "normal" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4552
	    fnWeight = FW_NORMAL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4553
	} else if (strcmp( work, "light" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4554
	    fnWeight = FW_LIGHT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4555
	} else if (strcmp( work, "demi" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4556
	    fnWeight = FW_LIGHT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4557
	} else if (strcmp( work, "heavy" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4558
	    fnWeight = FW_HEAVY;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4559
	} else if (strcmp( work, "extraBold" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4560
	    fnWeight = FW_EXTRABOLD;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4561
	} else if (strcmp( work, "semiBold" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4562
	    fnWeight = FW_SEMIBOLD;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4563
	} else if (strcmp( work, "thin" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4564
	    fnWeight = FW_THIN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4565
	} else if (strcmp( work, "extraLight" ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4566
	    fnWeight = FW_EXTRALIGHT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4567
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4568
    } else if (__isSmallInteger(weight)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4569
	fnWeight = __intVal(weight);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4570
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4571
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4572
    if(__isSmallInteger( logSize )) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4573
	nHeight = __intVal( logSize );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4574
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4575
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4576
    if (__isString(slant)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4577
	work2 = __stringVal( slant );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4578
	work  = __stringVal( slant );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4579
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4580
	if (strncmp(work2, "italic", 6) == 0)  {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4581
	    fdwItalic = TRUE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4582
	    if ( work2[6] == '-' )
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4583
		strncpy( work, &work2[7], ( strlen( work2) - 7) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4584
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4585
	    if (strncmp(work2, "oblique", 7) == 0)  {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4586
		fdwItalic = TRUE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4587
		if ( work2[7] == '-' )
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4588
		    strncpy( work, &work2[8], ( strlen( work2) - 8) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4589
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4590
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4591
	if (strncmp( work, "underline", 9 ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4592
	    fdwUnderline = TRUE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4593
	    if( work[10] == '-' )
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4594
		strncpy( work2, &work[11], ( strlen( work ) - 10 ) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4595
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4596
	if (strncmp( work2, "strikeOut", 9 ) == 0 ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4597
	    fdwStrikeOut = TRUE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4598
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4599
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4600
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4601
    DPRINTF(("CreateFont face:%s h=%d w=%d wght=%d\n",
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4602
		faceName, nHeight, nWidth, fnWeight));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4603
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4604
    hFont = CreateFont( -nHeight,   /* character height - not cell height */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4605
			nWidth,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4606
			nEscapement,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4607
			nOrientation,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4608
			fnWeight,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4609
			fdwItalic,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4610
			fdwUnderline,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4611
			fdwStrikeOut,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4612
			fdwCharSet,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4613
			fdwOutputPrecision,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4614
			fdwClipPrecision,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4615
			fdwQuality,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4616
			fdwPitchAndFamily,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4617
			faceName );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4618
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4619
    if (hFont != NULL) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4620
	DPRINTF(("createFont: %x\n", hFont));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4621
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4622
    #ifdef COUNT_RESOURCES
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4623
	__cnt_font++;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4624
	RES1PRINTF(("CreateFont %d\n", __cnt_font));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4625
    #endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4626
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4627
	RETURN ( __MKEXTERNALADDRESS(hFont) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4628
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4629
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4630
    DPRINTF(("***** ERROR createFontWithFoundry failed ERROR *****\n" ));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4631
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4632
    ^ nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4633
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4634
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4635
     Display getFontWithFoundry:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4636
			 family:'courier'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4637
			 weight:'medium'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4638
			  slant:'r'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4639
			spacing:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4640
		      pixelSize:nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4641
			   size:13
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4642
		       registry:'iso8859'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4643
		       encoding:'*'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4644
    "
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4645
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4646
    "new NT Version: 20.2.1997 / 22:33:29 / dq"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4647
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4648
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4649
primFontMetricsOf:fontId hdc:aDC intoArray:rawData
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4650
    "evaluate aBlock, passing a fonts metrics as arguments.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4651
     fill passed array as:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4652
      ascent     -> (data at:1)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4653
      descent    -> (data at:2)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4654
      maxAscent  -> (data at:3)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4655
      maxDescent -> (data at:4)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4656
      minWidth   -> (data at:5)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4657
      maxWidth   -> (data at:6)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4658
      avgWidth   -> (data at:7).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4659
      minChar    -> (data at:8).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4660
      maxChar    -> (data at:9).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4661
      defaultChar-> (data at:10).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4662
      charSet    -> (data at:11).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4663
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4664
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4665
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4666
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4667
    if (__isExternalAddress(fontId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4668
     && __isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4669
     && __isArray(rawData)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4670
     && (__arraySize(rawData) >= 11)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4671
	SIZE size;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4672
	int avgWidth;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4673
	HGDIOBJ hFont;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4674
	HGDIOBJ prevFont;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4675
	TEXTMETRIC tmet;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4676
	static char *s = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4677
	static int len;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4678
	OBJ t;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4679
	HANDLE hDC;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4680
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4681
	hFont = _HGDIOBJVal(fontId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4682
	hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4683
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4684
	/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4685
	 * temporarily set this font in the tmpDC (root-) context
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4686
	 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4687
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4688
	prevFont = SelectObject(hDC, hFont);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4689
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4690
	GetTextMetricsW(hDC, &tmet);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4691
	if (len == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4692
	    len = strlen(s);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4693
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4694
#if 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4695
	GetTextExtentPoint32(hDC, s, len, &size);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4696
	avgWidth = (size.cx / (len / 2) + 1) / 2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4697
#else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4698
	avgWidth = tmet.tmAveCharWidth;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4699
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4700
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4701
	__ArrayInstPtr(rawData)->a_element[0] = __MKSMALLINT(tmet.tmAscent);        /* ascent     -> (data at:1) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4702
	__ArrayInstPtr(rawData)->a_element[1] = __MKSMALLINT(tmet.tmDescent);       /* descent    -> (data at:2) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4703
	__ArrayInstPtr(rawData)->a_element[2] = __MKSMALLINT(tmet.tmAscent);        /* maxAscent  -> (data at:3) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4704
	__ArrayInstPtr(rawData)->a_element[3] = __MKSMALLINT(tmet.tmDescent);       /* maxDescent -> (data at:4) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4705
	__ArrayInstPtr(rawData)->a_element[4] = __MKSMALLINT(avgWidth);             /* minWidth   -> (data at:5) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4706
	__ArrayInstPtr(rawData)->a_element[5] = __MKSMALLINT(tmet.tmMaxCharWidth);  /* maxWidth   -> (data at:6) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4707
	__ArrayInstPtr(rawData)->a_element[6] = __MKSMALLINT(avgWidth);             /* avgWidth   -> (data at:7) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4708
	__ArrayInstPtr(rawData)->a_element[7] = __MKSMALLINT(tmet.tmFirstChar);     /* min        -> (data at:8) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4709
	__ArrayInstPtr(rawData)->a_element[8] = __MKSMALLINT(tmet.tmLastChar);      /* max        -> (data at:9) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4710
	__ArrayInstPtr(rawData)->a_element[9] = __MKSMALLINT(tmet.tmDefaultChar);   /* default    -> (data at:10) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4711
#if 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4712
	t = __charSetSymbolFor(tmet.tmCharSet);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4713
	__ArrayInstPtr(rawData)->a_element[10]= t; __STORE(rawData, t);             /* charSet    -> (data at:11) */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4714
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4715
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4716
	DPRINTF(("textMetrics h=%x  avgAsc=%d avgDesc=%d minW=%d maxW=%d avgW=%d\n",
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4717
		    hFont, tmet.tmAscent, tmet.tmDescent, avgWidth, tmet.tmMaxCharWidth,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4718
		    tmet.tmAveCharWidth));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4719
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4720
	SelectObject(hDC, prevFont);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4721
	RETURN (self);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4722
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4723
    RETURN (nil);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4724
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4725
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4726
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4727
releaseFont:aFontId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4728
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4729
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4730
    if (__isExternalAddress(aFontId)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4731
	HGDIOBJ hFont = _HGDIOBJVal(aFontId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4732
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4733
	if (hFont) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4734
	   DPRINTF(("ReleaseFont: %x\n", hFont));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4735
	   DeleteObject(hFont);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4736
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4737
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4738
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4739
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4740
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4741
setFont:aFontId in:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4742
    "set font to be drawn in"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4743
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4744
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4745
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4746
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4747
     && __isExternalAddress(aFontId))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4748
    {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4749
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4750
	HGDIOBJ prevFont, hFont;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4751
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4752
	hFont = _HGDIOBJVal(aFontId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4753
	prevFont = SelectObject(hDC, hFont);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4754
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4755
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4756
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4757
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4758
    self primitiveFailed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4759
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4760
    "Created: / 04-08-2006 / 12:32:53 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4761
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4762
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4763
widthOf:aString from:index1 to:index2 inFont:aFontId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4764
   | gcId |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4765
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4766
   gcId :=self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4767
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4768
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4769
    unsigned char *cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4770
    int len, n, i1, i2, l;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4771
    OBJ cls;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4772
    int nInstBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4773
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4774
    if (__bothSmallInteger(index1, index2)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4775
     && __isExternalAddress(aFontId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4776
     && __isExternalAddressLike(gcId)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4777
     && __isNonNilObject(aString)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4778
	HGDIOBJ hFont,prevFont;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4779
	HANDLE hDC;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4780
	SIZE tsize;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4781
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4782
#ifndef PRE_22_FEP_2007
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4783
#       define N_QUICK_CHARS    1024
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4784
	unsigned short quickWchars[N_QUICK_CHARS];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4785
	unsigned short *wcharPtr;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4786
	int mustFree = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4787
	int i;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4788
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4789
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4790
	hFont = _HGDIOBJVal(aFontId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4791
	hDC = (HANDLE)(__externalAddressVal(gcId));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4792
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4793
	prevFont = SelectObject(hDC, hFont);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4794
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4795
	i1 = __intVal(index1) - 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4796
	cls = __qClass(aString);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4797
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4798
	if (i1 >= 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4799
	    i2 = __intVal(index2) - 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4800
	    if (i2 < i1) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4801
		RETURN ( __MKSMALLINT( 0 ) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4802
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4803
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4804
	    cp = (char *) __stringVal(aString);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4805
	    l = i2 - i1 + 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4806
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4807
	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4808
		n = __stringSize(aString);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4809
    commonWidthChars:
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4810
		if (i2 < n) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4811
		    cp += i1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4812
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4813
#ifdef PRE_22_FEP_2007
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4814
		    GetTextExtentPoint32(hDC, cp, l, &tsize);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4815
#else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4816
		    if (l <= N_QUICK_CHARS) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4817
			wcharPtr = quickWchars;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4818
			mustFree = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4819
		    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4820
			wcharPtr = malloc(sizeof(short)*l);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4821
			if (! wcharPtr) RETURN (__MKSMALLINT(0));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4822
			mustFree = 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4823
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4824
		    for (i=0; i<l; i++) wcharPtr[i] = ((unsigned char *)cp)[i];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4825
		    GetTextExtentPoint32W(hDC, wcharPtr, l, &tsize);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4826
		    if (mustFree) free(wcharPtr);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4827
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4828
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4829
#ifdef SUPERDEBUG
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4830
		    if (__debug__) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4831
			char buf[80];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4832
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4833
			GetTextFace(hDC,80,buf);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4834
			console_printf("font1 %x %s >%s< l=%d dx=%d\n",hFont,buf,cp,l,tsize.cx);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4835
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4836
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4837
		    SelectObject(hDC, prevFont);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4838
		    RETURN ( __MKSMALLINT(tsize.cx) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4839
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4840
		RETURN (__MKSMALLINT(0));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4841
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4842
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4843
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4844
	    cp += nInstBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4845
	    n = __byteArraySize(aString) - nInstBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4846
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4847
	    if (__isBytes(aString)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4848
		goto commonWidthChars;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4849
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4850
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4851
	    /* Unicode */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4852
	    if (__isWords(aString)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4853
		n = n / 2;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4854
		if (i2 < n) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4855
		    WIDECHAR *w_cp = (WIDECHAR *)cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4856
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4857
		    w_cp += i1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4858
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4859
		    GetTextExtentPoint32W(hDC, w_cp, l, &tsize);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4860
		    SelectObject(hDC, prevFont);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4861
		    RETURN ( __MKSMALLINT(tsize.cx) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4862
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4863
		RETURN (__MKSMALLINT(0));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4864
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4865
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4866
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4867
%}.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4868
    self primitiveFailed.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4869
    ^ 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4870
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4871
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4872
widthOf:aString inFont:aFontId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4873
    "return the width in pixels of a string in a specific font"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4874
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4875
    ^ self widthOf:aString from:1 to:(aString size) inFont:aFontId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4876
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4877
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4878
!WinPrinterContext methodsFor:'initialization & release'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4879
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4880
createDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4881
    "Private - Create a device context for the receiver"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4882
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4883
    self gcId: printerInfo createDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4884
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4885
    "Created: / 27-07-2006 / 10:21:05 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4886
    "Modified: / 02-08-2006 / 17:30:47 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4887
    "Modified: / 10-10-2006 / 18:14:28 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4888
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4889
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4890
deleteDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4891
    "Private - Delete a device context for the receiver"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4892
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4893
    OperatingSystem deletePrinterDC: self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4894
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4895
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4896
destroy
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4897
    "Destroy the GC."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4898
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4899
    |id|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4900
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4901
    id := self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4902
    id notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4903
	self gcId: nil.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4904
	self deleteDC.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4905
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4906
"/    Lobby unregister:self.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4907
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4908
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4909
destroyGC:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4910
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4911
    if (__isExternalAddressLike(aDC)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4912
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4913
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4914
	DeleteDC(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4915
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4916
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4917
#ifdef CACHE_LAST_DC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4918
	if (lastGcData == gcData) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4919
	    _releaseDC(gcData);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4920
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4921
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4922
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4923
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4924
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4925
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4926
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4927
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4928
executor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4929
    |aCopy|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4930
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4931
    aCopy := WinWorkstation::PrinterDeviceContextHandle basicNew.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4932
    aCopy setDevice:self device id:nil gcId:self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4933
    ^ aCopy
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4934
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4935
    "Created: / 16-04-2007 / 12:39:02 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4936
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4937
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4938
initialize
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4939
    super initialize.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4940
"/    deviceForms := Registry new.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4941
"/    deviceColors := Registry new.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4942
    deviceFonts := CachingRegistry new cacheSize:10.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4943
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4944
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4945
releaseDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4946
    "Private - Delete and clear the device context of the receiver."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4947
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4948
    self deleteDC.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4949
"/    device close.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4950
    self gcId: nil.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4951
    self releaseDeviceFonts
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4952
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4953
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4954
releaseDeviceFonts
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4955
    deviceFonts isEmptyOrNil ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4956
	deviceFonts do:[:afont |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4957
	    afont releaseFromDevice.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4958
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4959
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4960
    deviceFonts := CachingRegistry new cacheSize:10.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4961
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4962
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4963
!WinPrinterContext methodsFor:'non standard methods'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4964
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4965
stringWidthOf:aString at:index
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4966
    "Return the width of aString up to index
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4967
     when written using the current font; expand tabs out
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4968
     to 4 spaces for calculations"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4969
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4970
    |answer str size spaceWidth|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4971
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4972
    index <= 0 ifTrue:[ ^ 0 ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4973
    str := index >= aString size ifTrue:[ aString ] ifFalse:[ aString copyFrom:1 to:index ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4974
    true "self font isNil" ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4975
	"if font not set yet, calculate based on default font"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4976
	"/            extString := str asExternalString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4977
	size := Win32OperatingSystem::WinPointStructure new.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4978
	(OperatingSystem
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4979
	    getTextExtentPoint:self gcId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4980
	    string:str
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4981
	    size:size) ifFalse:[ ^ self error ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4982
	answer := size x.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4983
"/        Transcript showCR: 'FROM PRIM ******* ', str, '   ',  answer printString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4984
"/        Transcript showCR: 'FROM DEVICE ***** ', str, '   ',(self font widthOf:str on:self device) printString.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4985
	#TODO.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4986
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4987
	answer := self font widthOf:str on:self device
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4988
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4989
    index > aString size ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4990
	spaceWidth := self font widthOf:Character space on:self device.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4991
	answer := answer + ((index - aString size) * spaceWidth)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4992
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4993
    ^ answer.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4994
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4995
    "Created: / 03-08-2006 / 10:27:20 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4996
    "Modified: / 04-08-2006 / 12:27:26 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4997
    "Modified: / 10-10-2006 / 18:20:43 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4998
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  4999
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5000
!WinPrinterContext methodsFor:'not supported yet'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5001
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5002
displayAdvanceLineFrom:point1 to:point2
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5003
    "draw a line"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5004
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5005
    self displayAdvanceLineFromX:(point1 x) y:(point1 y)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5006
		      toX:(point2 x) y:(point2 y)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5007
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5008
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5009
displayAdvanceLineFromX:x0 y:y0 toX:x1 y:y1
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5010
    "draw a line (with current paint-color); apply transformation if nonNil"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5011
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5012
    |pX0 pY0 pX1 pY1 easy fgId bgId|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5013
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5014
    self gcId isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5015
	self initGC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5016
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5017
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5018
    self lineStyle == #doubleDashed ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5019
	"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5020
	 if bgPaint or paint is not a real color, we have to do it the hard way ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5021
	"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5022
	easy := true.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5023
	self paint isColor ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5024
	    easy := false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5025
	] ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5026
	    fgId := self paint colorId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5027
	    fgId isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5028
		easy := false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5029
	    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5030
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5031
	self bgPaint isColor ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5032
	    easy := false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5033
	] ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5034
	    bgId := self bgPaint colorId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5035
	    bgId isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5036
		easy := false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5037
	    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5038
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5039
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5040
	easy ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5041
	    ((self foreground ~~ self paint) or:[self background ~~ self bgPaint]) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5042
		self device setForeground:fgId background:bgId in:self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5043
		self foreground: self paint.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5044
		self background: self bgPaint.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5045
	    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5046
	] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5047
	    'DeviceGraphicsContext [warning]: cannot draw dashes with dithered colors' errorPrintCR
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5048
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5049
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5050
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5051
    self transformation notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5052
	pX0 := self transformation applyToX:x0.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5053
	pY0 := self transformation applyToY:y0.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5054
	pX1 := self transformation applyToX:x1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5055
	pY1 := self transformation applyToY:y1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5056
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5057
	pX0 := x0.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5058
	pY0 := y0.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5059
	pX1 := x1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5060
	pY1 := y1
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5061
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5062
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5063
    pX0 := pX0 rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5064
    pY0 := pY0 rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5065
    pX1 := pX1 rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5066
    pY1 := pY1 rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5067
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5068
    self device displayAdvanceLineFromX:pX0 y:pY0 toX:pX1 y:pY1 in:self drawableId with:self gcId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5069
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5070
    "Modified: 10.1.1997 / 17:46:32 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5071
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5072
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5073
displayAdvanceLineFromX:x0 y:y0 toX:x1 y:y1 in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5074
    "draw a line. If the coordinates are not integers, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5075
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5076
    self getPenForMyContext.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5077
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5078
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5079
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5080
     && __bothSmallInteger(x0, y0)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5081
     && __bothSmallInteger(x1, y1)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5082
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5083
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5084
	int __x1 = __intVal(x1), __y1 = __intVal(y1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5085
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5086
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5087
/*      DPRINTF(("displayLine: %d/%d -> %d/%d\n",
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5088
		    __intVal(x0), __intVal(y0),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5089
		    __x1, __y1));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5090
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5091
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5092
/*        fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5093
 *        hPen = CreatePen(PS_SOLID, 1, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5094
 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5095
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5096
	MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5097
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5098
	LineTo(hDC, __x1, __y1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5099
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5100
	/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5101
	 * end-point ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5102
	 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5103
	LineTo(hDC, __x1+1, __y1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5104
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5105
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5106
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5107
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5108
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5109
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5110
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5111
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5112
gcForBitmap:aDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5113
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5114
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5115
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5116
    if (__isExternalAddress(aDrawableId)){
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5117
	BITMAP bitmap;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5118
	HBITMAP hBitmap = _HBITMAPVAL(aDrawableId);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5119
	HBITMAP memBM;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5120
	HANDLE compatibleDC, rootDC, hdcScreen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5121
   //     HANDLE printerDC = (HANDLE)(__externalAddressVal(__INST(gcId)));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5122
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5123
	if (! hBitmap) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5124
	    RETURN (nil);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5125
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5126
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5127
	if (GetObject(hBitmap, sizeof(bitmap), &bitmap)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5128
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5129
	    DDPRINTF(("bitmap info:%d\n", bitmap.bmBitsPixel));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5130
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5131
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5132
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5133
	    DPRINTF(("noinfo returned for bitmap\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5134
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5135
	    /* mhmh - can this happen ? */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5136
	    bitmap.bmBitsPixel = 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5137
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5138
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5139
	gcData->hBitmap = hBitmap;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5140
	gcData->bitmapColorBitCount = bitmap.bmBitsPixel;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5141
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5142
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5143
	rootDC  = CreateDC("DISPLAY", NULL, NULL, NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5144
	compatibleDC = CreateCompatibleDC(rootDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5145
	SelectObject(compatibleDC, hBitmap);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5146
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5147
   //     hdcScreen= CreateDC("NULL", NULL, NULL, NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5148
   //       compatibleDC =  rootDC;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5149
   //     compatibleDC = CreateCompatibleDC(printerDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5150
   //     compatibleDC = CreateCompatibleDC(0);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5151
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5152
   //     memBM = CreateCompatibleBitmap ( compatibleDC, bitmap.bmWidth, bitmap.bmHeight );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5153
   //     SelectObject ( compatibleDC, memBM );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5154
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5155
	RETURN (__MKEXTERNALADDRESS(compatibleDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5156
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5157
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5158
	RETURN ( __MKEXTERNALADDRESS(gcData) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5159
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5160
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5161
    RETURN (nil);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5162
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5163
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5164
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5165
getPenForMyContext
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5166
    "Get a pen for my context"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5167
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5168
    |maskOriginX maskOriginY gcId lineWidthObj lineStyleObj capStyleObj joinStyleObj maskObj |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5169
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5170
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5171
    self maskOrigin isNil ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5172
	maskOriginX := self maskOrigin x.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5173
	maskOriginY := self maskOrigin y.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5174
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5175
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5176
    		gcId := self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5177
	lineWidthObj := self lineWidth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5178
	lineStyleObj := self lineStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5179
	 capStyleObj := self capStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5180
	joinStyleObj := self joinStyle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5181
         maskObj := self mask.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5182
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5183
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5184
    HPEN hPen = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5185
    HPEN prevPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5186
    LOGBRUSH Brush;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5187
    COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5188
    HANDLE hDC = (HANDLE)(__externalAddressVal(gcId));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5189
    int lStyle, bkMode, hMask, maskOrgX, maskOrgY;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5190
    OBJ lineStyle, capStyle, joinStyle;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5191
    int style;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5192
    int lw;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5193
    int BK_TRANSPARENT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5194
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5195
    BK_TRANSPARENT = 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5196
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5197
    lw= __intVal(lineWidthObj);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5198
/*    fgColor = __intVal(__INST(foreground)) & 0xffffff;     */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5199
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5200
    fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5201
    lineStyle=lineStyleObj;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5202
    capStyle=capStyleObj;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5203
    joinStyle=joinStyleObj;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5204
    hMask= __intVal(maskObj);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5205
    maskOrgX=__intVal(maskOriginX);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5206
    maskOrgY=__intVal(maskOriginY);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5207
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5208
    if (lineStyle == @symbol(solid)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5209
	style = PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5210
    } else if (lineStyle == @symbol(dashed)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5211
	style= PS_DASH;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5212
    } else if (lineStyle == @symbol(dotted)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5213
	style= PS_DOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5214
    } else if (lineStyle == @symbol(dashDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5215
	style= PS_DASHDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5216
    } else if (lineStyle == @symbol(dashDotDot)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5217
	style= PS_DASHDOTDOT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5218
    } else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5219
	style= PS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5220
    lStyle &= ~PS_STYLE_MASK;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5221
    lStyle |= style;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5222
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5223
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5224
    if (capStyle == @symbol(round)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5225
	style = PS_ENDCAP_ROUND;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5226
    } else if (capStyle == @symbol(square)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5227
	style = PS_ENDCAP_SQUARE;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5228
    } else if (capStyle == @symbol(flat)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5229
	style = PS_ENDCAP_FLAT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5230
    } else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5231
	style = PS_ENDCAP_FLAT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5232
    lStyle &= ~PS_ENDCAP_MASK;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5233
    lStyle |= style;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5234
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5235
    if (joinStyle == @symbol(bevel)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5236
	style = PS_JOIN_BEVEL;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5237
    } else if (joinStyle == @symbol(miter)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5238
	style = PS_JOIN_MITER;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5239
    } else if (joinStyle == @symbol(round)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5240
	style = PS_JOIN_ROUND;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5241
    } else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5242
	style = PS_JOIN_MITER;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5243
    lStyle &= ~PS_JOIN_MASK;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5244
    lStyle |= style;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5245
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5246
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5247
    if (((lStyle & PS_STYLE_MASK) == PS_SOLID)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5248
     && (hMask == 0)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5249
     && (lw /* lineWidth */ <= 1)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5250
	if (fgColor == 0 /* BlackPixel */ ) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5251
	    hPen = GetStockObject(BLACK_PEN);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5252
	    prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5253
	    RETURN( __MKEXTERNALADDRESS(hPen) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5254
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5255
	if (fgColor == 1 /* WhitePixel */) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5256
	    hPen = GetStockObject(WHITE_PEN);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5257
	    prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5258
	    RETURN( __MKEXTERNALADDRESS(hPen) );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5259
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5260
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5261
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5262
    hPen = (HPEN) 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5263
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5264
    if (0 /* __isWinNT */) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5265
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5266
	if (lw == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5267
	    lw = 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5268
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5269
	/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5270
	 * NT supports masked drawing with any lineStyle,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5271
	 * and also non-solid lines with any lineWidth.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5272
	 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5273
	if (hMask) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5274
	    Brush.lbStyle = BS_PATTERN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5275
	    Brush.lbHatch = (DWORD)hMask;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5276
	    Brush.lbColor = fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5277
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5278
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5279
#ifndef PRE_07_APR_04
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5280
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5281
	    hPen = CreatePen((lStyle & PS_STYLE_MASK), lw, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5282
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5283
/*            RESPRINTF(("CreatePen %x %d(%d) %x %x\n",
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5284
 *                       lStyle,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5285
 *                       lw, __INST(lineWidth),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5286
 *                       fgColor, hMask));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5287
 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5288
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5289
	    SetBkMode(hDC, TRANSPARENT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5290
	    bkMode = BK_TRANSPARENT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5291
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5292
#else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5293
	    Brush.lbStyle = BS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5294
	    Brush.lbHatch = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5295
	    Brush.lbColor = fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5296
#endif
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5297
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5298
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5299
	if (! hPen)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5300
	{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5301
	    hPen = ExtCreatePen(PS_GEOMETRIC | lStyle,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5302
			    lw, /* lineWidth, */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5303
			    &Brush,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5304
			    0, 0);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5305
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5306
/*            RESPRINTF(("ExtCreatePen1 %x %d(%d) %x %x\n",
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5307
 *                       lStyle,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5308
 *                       lw, __INST(lineWidth),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5309
 *                       fgColor, hMask));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5310
 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5311
	    if (hMask) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5312
		SetBrushOrgEx(hDC, maskOrgX, maskOrgY, 0);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5313
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5314
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5315
    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5316
	/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5317
	 * W95 only supports masked drawing with SOLID lines
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5318
	 * also, we should use COSMETIC pens if possible
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5319
	 * with non-solid lineStyles.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5320
	 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5321
	if ((lStyle & PS_STYLE_MASK) == PS_SOLID) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5322
	    int ps = PS_GEOMETRIC;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5323
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5324
	    if (hMask) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5325
		Brush.lbStyle = BS_PATTERN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5326
		Brush.lbHatch = (DWORD)hMask;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5327
		Brush.lbColor = fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5328
	    } else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5329
		Brush.lbStyle = BS_SOLID;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5330
		Brush.lbHatch = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5331
		Brush.lbColor = fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5332
		if (lw /* lineWidth */ <= 1) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5333
		    ps = PS_COSMETIC;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5334
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5335
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5336
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5337
	    hPen = ExtCreatePen(ps | lStyle,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5338
				lw, /* lineWidth */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5339
				&Brush,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5340
				0, 0);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5341
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5342
/*            RESPRINTF(("ExtCreatePen1 %x %d %x %x\n",
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5343
 *                           lStyle,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5344
 *                           lw,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5345
 *                           fgColor, hMask));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5346
 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5347
	    if (hMask) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5348
		SetBrushOrgEx(hDC, maskOrgX, maskOrgY, 0);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5349
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5350
	} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5351
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5352
	    if (lw == 1) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5353
		lw = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5354
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5355
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5356
	    /*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5357
	     * dashes only supported with lineWidth 0
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5358
	     */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5359
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5360
	    hPen = CreatePen((lStyle & PS_STYLE_MASK),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5361
			     lw,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5362
			     fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5363
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5364
/*            RESPRINTF(("CreatePen %x %d %x\n",
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5365
 *                               (lStyle & PS_STYLE_MASK),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5366
 *                               lw,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5367
 *                               fgColor));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5368
 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5369
	    //
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5370
	    // CG: wrong; must set to opaque, if doubleDashed
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5371
	    //
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5372
	    SetBkMode(hDC, TRANSPARENT);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5373
	    bkMode = BK_TRANSPARENT;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5374
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5375
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5376
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5377
    prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5378
    RETURN (__MKEXTERNALADDRESS(hPen));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5379
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5380
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5381
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5382
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5383
xprimDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd width:imageWidth height:imageHeight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5384
				  x:srcx y:srcy
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5385
			       into:ignoredDrawableId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5386
				  x:dstx y:dsty
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5387
			      width:w height:h
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5388
			       with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5389
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5390
    "since XPutImage may allocate huge amount of stack space
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5391
     (some implementations use alloca), this must run with unlimited stack."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5392
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5393
%{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5394
    unsigned char fastBits[10000];
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5395
    unsigned char *b_bits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5396
    unsigned char *allocatedBits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5397
    unsigned char *__imageBits = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5398
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5399
    if (__isByteArray(imageBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5400
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5401
    } else if (__isExternalBytesLike(imageBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5402
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5403
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5404
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5405
    if (/* ISCONNECTED
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5406
     && */  __isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5407
     && __bothSmallInteger(srcx, srcy)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5408
     && __bothSmallInteger(dstx, dsty)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5409
     && __bothSmallInteger(w, h)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5410
     && __bothSmallInteger(imageWidth, imageHeight)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5411
     && __bothSmallInteger(imageDepth, bitsPerPixel)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5412
     && __isSmallInteger(padd)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5413
     && __imageBits)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5414
     {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5415
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5416
	struct
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5417
	{
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5418
	  BITMAPINFOHEADER bmiHeader;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5419
	  DWORD r;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5420
	  DWORD g;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5421
	  DWORD b;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5422
	} bitmap;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5423
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5424
	if (__intVal(padd) != WIN32PADDING) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5425
	    int row, col;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5426
	    unsigned char *cp;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5427
	    unsigned char *pBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5428
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5429
	    int bi = __intVal(bitsPerPixel);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5430
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5431
	    b_width = __intVal(w);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5432
	    b_height = __intVal(h);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5433
	    bytesPerRowST = (b_width * bi + (__intVal(padd)-1)) / __intVal(padd);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5434
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5435
	    padding = bytesPerRowWN - bytesPerRowST;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5436
	    nBytes = b_height * bytesPerRowWN;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5437
	    /*console_printf("padd %d bs %d bw %d p %d\n",__intVal(padd),bytesPerRowST,bytesPerRowWN,padding);*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5438
	    if (padding) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5439
		if (nBytes < sizeof(fastBits)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5440
		    cp = b_bits = fastBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5441
		} else {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5442
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5443
		}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5444
		if (cp) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5445
		    pBits = __imageBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5446
		    for (row = b_height; row; row--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5447
			for (col = bytesPerRowST; col; col--) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5448
			    *cp++ = *pBits++;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5449
			}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5450
			cp += padding;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5451
		    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5452
		} else
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5453
		    goto fail;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5454
	    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5455
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5456
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5457
	if (b_bits == 0) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5458
	    b_bits = __imageBits;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5459
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5460
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5461
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5462
	bitmap.bmiHeader.biPlanes = 1;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5463
	if (__intVal(imageDepth) == 24) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5464
	    /*bitmap.bmiHeader.biCompression = BI_BITFIELDS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5465
	    bitmap.r = 0xff0000;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5466
	    bitmap.g = 0x00ff00;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5467
	    bitmap.b = 0x0000ff;*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5468
	    bitmap.bmiHeader.biCompression = BI_RGB;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5469
	} else if (__intVal(imageDepth) == 16) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5470
	    /*bitmap.bmiHeader.biCompression = BI_RGB;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5471
	    bitmap.bmiHeader.biCompression = BI_BITFIELDS;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5472
	    bitmap.b = 0x001f;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5473
	    bitmap.g = 0x07e0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5474
	    bitmap.r = 0xf800;*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5475
	    bitmap.b = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5476
	    bitmap.g = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5477
	    bitmap.r = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5478
	    bitmap.bmiHeader.biCompression = BI_RGB;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5479
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5480
	bitmap.bmiHeader.biSizeImage = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5481
	bitmap.bmiHeader.biXPelsPerMeter = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5482
	bitmap.bmiHeader.biYPelsPerMeter = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5483
	bitmap.bmiHeader.biClrUsed = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5484
	bitmap.bmiHeader.biClrImportant = 0;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5485
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5486
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5487
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5488
	/*console_printf("drawBits depth:%d bitsPerPixel:%d IW%d W:%d H:%d\n",__intVal(imageDepth),bitmap.bmiHeader.biBitCount,bitmap.bmiHeader.biWidth,__intVal(w),bitmap.bmiHeader.biHeight);*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5489
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5490
			      __intVal(w), __intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5491
			      __intVal(srcx), __intVal(srcy),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5492
			      0,__intVal(h),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5493
			      (void *)b_bits,
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5494
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5495
	if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5496
	    free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5497
	}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5498
	RETURN ( true );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5499
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5500
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5501
fail: ;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5502
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5503
    PRINTF(("create temp bitmap FAILED!!!\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5504
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5505
    if (allocatedBits) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5506
/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5507
	PRINTF(("freeing up temp bitmap bits ...\n"));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5508
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5509
	free(allocatedBits);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5510
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5511
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5512
.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5513
    ^ false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5514
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5515
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5516
xxxdisplayLineFromX:x0 y:y0 toX:x1 y:y1 in:ignoredDrawableId with:aDC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5517
    "draw a line. If the coordinates are not integers, an error is triggered."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5518
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5519
    |penHandle|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5520
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5521
    penHandle := self getPenForMyContext.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5522
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5523
%{  /* NOCONTEXT */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5524
    if (__isExternalAddressLike(aDC)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5525
     && __isExternalAddressLike(penHandle)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5526
     && __bothSmallInteger(x0, y0)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5527
     && __bothSmallInteger(x1, y1)) {
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5528
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5529
	HANDLE hPen = (HANDLE)(__externalAddressVal(penHandle));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5530
	COLORREF fgColor;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5531
	HANDLE prevPen;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5532
	int __x1 = __intVal(x1), __y1 = __intVal(y1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5533
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5534
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5535
/*      DPRINTF(("displayLine: %d/%d -> %d/%d\n",
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5536
		    __intVal(x0), __intVal(y0),
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5537
		    __x1, __y1));
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5538
*/
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5539
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5540
/*        fgColor = GetTextColor(hDC);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5541
 *        hPen = CreatePen(PS_SOLID, 1, fgColor);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5542
 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5543
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5544
	prevPen = SelectObject(hDC, hPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5545
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5546
	MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5547
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5548
	LineTo(hDC, __x1, __y1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5549
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5550
	/*
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5551
	 * end-point ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5552
	 */
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5553
	LineTo(hDC, __x1+1, __y1);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5554
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5555
	SelectObject(hDC, prevPen);
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5556
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5557
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5558
	RETURN ( self );
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5559
    }
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5560
%}
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5561
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5562
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5563
!WinPrinterContext methodsFor:'printing process'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5564
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5565
endPage
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5566
    "Informs device that we are finished writing to a page."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5567
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5568
    (OperatingSystem endPage:self gcId) > 0 ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5569
	self error
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5570
    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5571
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5572
    "Created: / 27-07-2006 / 18:20:48 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5573
    "Modified: / 01-08-2006 / 16:01:34 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5574
    "Modified: / 10-10-2006 / 18:14:44 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5575
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5576
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5577
endPrintJobWithoutRelease
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5578
    "End the print job.  Everything drawn between startPrintJob
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5579
     and endPrintJob will become one entry in the print queue."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5580
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5581
    |result|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5582
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5583
    self endPage.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5584
    result := OperatingSystem endDoc:self gcId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5585
    jobid := nil.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5586
    result >= 0 ifFalse:[ self error ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5587
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5588
    "Created: / 27-07-2006 / 18:21:04 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5589
    "Modified: / 01-08-2006 / 16:01:38 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5590
    "Modified: / 10-10-2006 / 18:50:43 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5591
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5592
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5593
getSupportsColor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5594
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5595
    | retVal info |
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5596
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5597
    info := (self class getPrinterInformationString: self name) asUppercase.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5598
    (info includesSubString: ',PSCRIPT,')
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5599
	ifTrue: [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5600
	    retVal := self class postScriptBlackWhite not.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5601
"/            retVal := (DAPASX::DapasSystemInfo getYesNoInfoApp: 'Printer' profile: 'PostScriptBlackWhite') not.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5602
	]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5603
	ifFalse: [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5604
	    retVal := (info includesSubString: 'PDF')
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5605
		ifTrue: [true]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5606
		ifFalse: [self numberOfColorBitsPerPixel > 1].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5607
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5608
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5609
    ^retVal
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5610
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5611
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5612
startPage
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5613
    "Starts a page."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5614
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5615
    (OperatingSystem startPage:self gcId) > 0 ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5616
	^ self error
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5617
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5618
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5619
    "Created: / 27-07-2006 / 18:25:55 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5620
    "Modified: / 28-07-2006 / 18:19:04 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5621
    "Modified: / 10-10-2006 / 18:19:02 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5622
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5623
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5624
startPrintJob:aString fileName:aFileName
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5625
    "Start a print job, using aString as the job title; everything
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5626
     drawn between startPrintJob and endPrintJob will become
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5627
     one entry in the print queue."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5628
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5629
    |docInfoStruct nameAddress fileNameAddress|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5630
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5631
    self gcId isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5632
	self buildPrinter
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5633
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5634
    abort := false.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5635
    title := aString ? 'Smalltalk/X'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5636
    nameAddress := title asExternalBytes unprotectFromGC.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5637
    aFileName isNil ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5638
	fileNameAddress := aFileName pathName asExternalBytes unprotectFromGC
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5639
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5640
    docInfoStruct := Win32OperatingSystem::DocInfoStructure new.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5641
    docInfoStruct
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5642
	cbSize:docInfoStruct sizeInBytes;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5643
	lpszDocName:nameAddress address.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5644
    fileNameAddress isNil ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5645
	docInfoStruct lpszOutput:fileNameAddress address
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5646
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5647
    jobid := OperatingSystem startDoc:self gcId docInfo:docInfoStruct.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5648
    jobid > 0 ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5649
	jobid = -1 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5650
	    abort := true.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5651
	    ^ nil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5652
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5653
"/        ^ self error
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5654
	OpenError raiseErrorString:'Cannot create printer job'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5655
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5656
    self startPage
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5657
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5658
    "Created: / 27-07-2006 / 18:19:31 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5659
    "Modified: / 03-08-2006 / 15:11:19 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5660
    "Modified: / 10-10-2006 / 18:20:01 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5661
    "Modified: / 07-04-2011 / 12:03:50 / sr"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5662
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5663
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5664
!WinPrinterContext methodsFor:'queries'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5665
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5666
hasGrayscales
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5667
    "return true, if this workstation supports grayscales
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5668
     (also true for color displays)"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5669
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5670
    ^ true
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5671
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5672
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5673
isOpen
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5674
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5675
    ^ self gcId notNil
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5676
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5677
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5678
isPersistentInSnapshot
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5679
    "return true, if resources on this device are to be made
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5680
     persistent in a snapshot image."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5681
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5682
    ^ false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5683
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5684
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5685
supportsColor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5686
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5687
    supportsColor isNil ifTrue:[supportsColor := self getSupportsColor].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5688
    ^supportsColor
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5689
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5690
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5691
supportsGraphics
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5692
    ^(OperatingSystem getDeviceCaps: self gcId index: 2 "Technology") ~= 4
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5693
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5694
    "Created: / 03-08-2006 / 10:07:43 / fm"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5695
    "Modified: / 16-04-2007 / 12:44:03 / cg"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5696
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5697
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5698
supportsVariableHeightFonts
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5699
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5700
    ^ false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5701
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5702
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5703
supportsXftFonts
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5704
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5705
    ^ false
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5706
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5707
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5708
!WinPrinterContext methodsFor:'registration'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5709
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5710
registerFont:aFont
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5711
    deviceFonts register:aFont.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5712
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5713
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5714
unregisterFont:aFont
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5715
    deviceFonts unregister:aFont.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5716
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5717
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5718
!WinPrinterContext::WinPrinterGraphicContext class methodsFor:'documentation'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5719
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5720
documentation
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5721
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5722
    The class is simular to the PSGraphicsContext. It implements a
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5723
    'what you see is what you get' interface - all is scaled dependent
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5724
    on the current screen resolution
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5725
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5726
    supports margin, clipping ...
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5727
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5728
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5729
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5730
examples
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5731
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5732
										[exBegin]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5733
    |gc font|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5734
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5735
    gc := WinPrinterContext openGraphicContext.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5736
    gc isNil ifTrue:[^ self ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5737
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5738
    [
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5739
	gc startPrintJob:'Test'.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5740
	gc paint:(Color black).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5741
	gc displayLineFromX:10 y:40 toX:100 y:40.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5742
	font := (Font family:'helvetica' face:'roman' style:'bold' size:16) onDevice:(gc device).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5743
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5744
	gc font:font.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5745
	gc paint:(Color red).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5746
	gc displayString:'hallo' x:10 y:(40 + font ascent).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5747
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5748
	gc paint:(Color black).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5749
	gc displayLineFromX:10 y:(40 + font height) toX:100 y:(40 + font height).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5750
    ] ensure:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5751
	gc close.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5752
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5753
										[exEnd]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5754
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5755
"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5756
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5757
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5758
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'accessing dimensions'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5759
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5760
bottomMargin
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5761
    "return the papers bottom margin measured in pixels"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5762
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5763
    ^ 50
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5764
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5765
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5766
extent
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5767
    ^ width @ height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5768
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5769
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5770
height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5771
    ^ height
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5772
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5773
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5774
leftMargin
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5775
    "return the papers left margin measured in pixels"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5776
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5777
    ^ 50
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5778
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5779
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5780
rightMargin
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5781
    "return the papers right margin measured in pixels"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5782
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5783
    ^ 50
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5784
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5785
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5786
topMargin
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5787
    "return the papers top margin measured in pixels"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5788
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5789
    ^ 50
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5790
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5791
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5792
width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5793
    ^ width
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5794
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5795
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5796
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'accessing-hooks'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5797
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5798
pageCounter
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5799
    "answer the current page number"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5800
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5801
    pageCounter ~~ 0 ifTrue:[^ pageCounter].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5802
    ^ 1
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5803
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5804
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5805
pageNumberFormat:aFormatString
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5806
    "set the pageNumber format - the default is 'page %1'"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5807
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5808
    pageNumberFormat := aFormatString ? ''
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5809
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5810
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5811
printPageNumbers:aBoolean
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5812
    "enable/disable printing of page numbers - the default is on"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5813
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5814
    printPageNumbers := aBoolean.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5815
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5816
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5817
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'accessing-transformation'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5818
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5819
clippingRectangle:aRectangle
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5820
    |tranlate extent lft rgt top bot|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5821
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5822
    tranlate := self translation negated asPoint.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5823
    extent   := self extent.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5824
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5825
    lft := tranlate x.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5826
    top := tranlate y.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5827
    rgt := lft + extent x.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5828
    bot := top + extent y.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5829
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5830
    aRectangle notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5831
	lft := lft max:aRectangle left.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5832
	top := top max:aRectangle top.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5833
	rgt := rgt min:aRectangle right.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5834
	bot := bot min:aRectangle bottom.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5835
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5836
    super clippingRectangle:(Rectangle left:lft top:top right:rgt bottom:bot).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5837
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5838
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5839
scale
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5840
    "answer the scale excluding the fontScale factor"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5841
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5842
    ^ super scale / fontScale
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5843
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5844
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5845
scale:aScale
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5846
    "set the scale and add the fontScale factor"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5847
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5848
    super scale:(fontScale * (aScale ? 1.0)).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5849
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5850
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5851
scale:scale translation:aPoint
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5852
    self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5853
	translation:aPoint;
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5854
	scale:scale.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5855
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5856
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5857
transformation
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5858
    "answer the transformation excluding the fontScale factor"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5859
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5860
    ^ WindowingTransformation scale:(self scale)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5861
			translation:(self translation).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5862
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5863
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5864
transformation:aTransformation
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5865
    "set the transformation and add the fontScale factor"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5866
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5867
    |s t|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5868
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5869
    aTransformation notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5870
	s := aTransformation scale.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5871
	t := aTransformation translation.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5872
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5873
    self scale:s.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5874
    self translation:t.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5875
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5876
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5877
translateBy:aTranslation
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5878
    "set the translation and add the fontScale factor"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5879
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5880
    aTranslation isNil ifTrue:[^ self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5881
    self translation:( self translation + (self scale * aTranslation)).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5882
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5883
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5884
translation
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5885
    "answer the translation excluding the fontScale factor"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5886
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5887
    |margin trans|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5888
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5889
    margin := Point x:(self leftMargin) y:(self topMargin).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5890
    trans  := (super translation / fontScale) rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5891
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5892
    ^ trans - margin
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5893
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5894
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5895
translation:aTranslation
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5896
    "set the translation and add the fontScale factor"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5897
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5898
    |trans|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5899
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5900
    trans := Point x:(self leftMargin) y:(self topMargin).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5901
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5902
    aTranslation notNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5903
	trans := trans + aTranslation.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5904
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5905
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5906
    super translation:((trans * fontScale) rounded).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5907
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5908
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5909
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'drawing strings'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5910
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5911
displayOpaqueString:aString from:index1 to:index2 x:x y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5912
    self displayString:aString from:index1 to:index2 x:x y:y.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5913
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5914
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5915
displayOpaqueString:aString x:x y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5916
    |end|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5917
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5918
    end := aString size.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5919
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5920
    end ~~ 0 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5921
	self displayOpaqueString:aString from:1 to:end x:x y:y.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5922
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5923
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5924
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5925
displayString:aString from:index1 to:index2 x:x y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5926
    "setup the special scale for strings before drawing"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5927
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5928
    |tscale fscale yFont xFont|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5929
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5930
    index2 < index1 ifTrue:[^ self].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5931
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5932
    self transformation isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5933
	self initTransformation.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5934
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5935
    tscale := self transformation scale.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5936
    fscale := tscale / fontScale.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5937
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5938
    xFont := x * fontScale x.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5939
    yFont := (y - self font ascent) * fontScale y.    "/ MM_TEXT - Ursprung liegt oben links
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5940
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5941
    self transformation scale:fscale.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5942
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5943
    super displayString:aString from:index1 to:index2
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5944
		x:xFont truncated
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5945
		y:yFont truncated.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5946
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5947
    self transformation scale:tscale.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5948
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5949
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5950
displayString:aString x:x y:y
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5951
    |end|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5952
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5953
    end := aString size.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5954
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5955
    end ~~ 0 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5956
	self displayString:aString from:1 to:end x:x y:y.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5957
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5958
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5959
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5960
displayString:aString x:x y:y angle:drawAngle opaque:opaque
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5961
    "angles other than 0 is not yet supported"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5962
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5963
    |angle|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5964
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5965
    angle := drawAngle.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5966
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5967
    angle >= 360 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5968
	angle := angle - (((angle // 360)) * 360)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5969
    ] ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5970
	angle < 0 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5971
	    angle := angle - (((angle // 360)) * 360).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5972
	    angle := angle + 360.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5973
	    angle >= 360 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5974
		angle := angle - (((angle // 360)) * 360)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5975
	    ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5976
	].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5977
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5978
    angle == 0 ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5979
	super displayString:aString x:x y:y angle:drawAngle opaque:opaque.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5980
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5981
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5982
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5983
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'font stuff'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5984
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5985
fontMetricsOf:fontId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5986
    "after retrieving the metrics, we have to scale the information"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5987
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5988
    |metrics|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5989
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5990
    metrics := super fontMetricsOf:fontId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5991
    metrics isNil ifTrue:[^ nil ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5992
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5993
    metrics ascent:((metrics ascent / fontScale y) rounded)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5994
	    descent:((metrics descent / fontScale y) rounded + 1)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5995
	    maxAscent:((metrics maxAscent / fontScale y) rounded)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5996
	    maxDescent:((metrics maxDescent / fontScale y) rounded + 1)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5997
	    minWidth:((metrics minWidth / fontScale x) rounded)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5998
	    maxWidth:((metrics maxWidth / fontScale x) rounded)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  5999
	    avgWidth:((metrics averageWidth / fontScale x) rounded).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6000
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6001
    ^ metrics
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6002
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6003
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6004
getFontWithFoundry:foundry family:family weight:weight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6005
	      slant:slant spacing:spc pixelSize:pixelSize size:pointSize
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6006
	      registry:registry encoding:encoding
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6007
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6008
    "compute the pixels dependent on the Screen current resolution"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6009
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6010
    |psize|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6011
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6012
    psize := pixelSize.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6013
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6014
    psize isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6015
	psize := (pointSize * (self getLogicalPixelSizeY) / (Screen current getLogicalPixelSizeY)) rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6016
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6017
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6018
    ^ super getFontWithFoundry:foundry family:family weight:weight
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6019
	      slant:slant spacing:spc pixelSize:psize size:pointSize
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6020
	      registry:registry encoding:encoding
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6021
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6022
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6023
titleFont
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6024
    "answer the font used for displaying page numbers..."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6025
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6026
    titleFont isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6027
	titleFont := Font family:'helvetica' face:'medium' style:'roman' size:10.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6028
	titleFont := titleFont onDevice:(self device).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6029
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6030
    ^ titleFont
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6031
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6032
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6033
titleFont:aFont
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6034
    "set the font used for displaying page numbers..."
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6035
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6036
    (aFont notNil and:[aFont ~= titleFont]) ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6037
	titleFont := aFont onDevice:(self device).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6038
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6039
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6040
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6041
widthOf:aString from:index1 to:index2 inFont:aFontId
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6042
    "after retrieving the width, we have to scale the width"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6043
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6044
    |w|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6045
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6046
    w := super widthOf:aString from:index1 to:index2 inFont:aFontId.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6047
    w := (w / fontScale x) rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6048
    ^ w
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6049
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6050
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6051
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'initialization & release'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6052
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6053
close
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6054
    "compatible with PSGraphicsContext"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6055
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6056
    self endPrintJob.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6057
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6058
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6059
initExtent
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6060
    "scale the extent"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6061
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6062
    fontScale := self resolution / Screen current resolution.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6063
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6064
    width  := (self printerWidthArea / fontScale x) rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6065
    width  := width - self leftMargin - self rightMargin.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6066
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6067
    height := (self printerHeightArea / fontScale y) rounded.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6068
    height := height - self topMargin - self bottomMargin.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6069
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6070
    self initTransformation.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6071
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6072
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6073
initTransformation
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6074
    |margin|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6075
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6076
    self transformation isNil ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6077
	margin := Point x:(self leftMargin) y:(self topMargin).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6078
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6079
	self transformation: (WindowingTransformation scale:fontScale
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6080
					    translation:(margin * fontScale)).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6081
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6082
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6083
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6084
initialize
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6085
    super initialize.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6086
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6087
    device := nil.      "super initialize did set it to Screen current"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6088
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6089
    pageCounter    := 0.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6090
    needsEndOfPage := false.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6091
    printPageNumbers := true.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6092
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6093
    Language == #de ifTrue:[ pageNumberFormat := 'Seite %1' ]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6094
		   ifFalse:[ pageNumberFormat := 'page %1'  ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6095
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6096
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6097
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'printing process'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6098
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6099
displayTitleDo:aNoneArgAction
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6100
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6101
    |oldClip oldTrans oldFont|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6102
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6103
    oldClip := self clipingRectangleOrNil.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6104
    oldClip notNil ifTrue:[ self deviceClippingBounds:nil ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6105
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6106
    oldTrans := self translation.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6107
    oldFont  := self font.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6108
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6109
    self  font:(self titleFont).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6110
    self  translation:0.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6111
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6112
    aNoneArgAction value.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6113
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6114
    self translation:oldTrans.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6115
    oldFont notNil ifTrue:[ self font:oldFont ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6116
    oldClip notNil ifTrue:[ self deviceClippingBounds:oldClip ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6117
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6118
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6119
endPage
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6120
    "ends the current page
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6121
     if the current page is already closed by endPage, the request will be ignored"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6122
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6123
    |s|
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6124
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6125
    needsEndOfPage ifFalse:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6126
	^ self
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6127
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6128
    needsEndOfPage := false.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6129
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6130
    printPageNumbers == true ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6131
	self displayTitleDo:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6132
	    self displayString:title
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6133
                 x:(self extent x - (self font widthOf:title)) // 2
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6134
                 y:(self extent y + (self font ascent)).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6135
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6136
	    s := pageNumberFormat bindWith:pageCounter.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6137
	    self displayString:s
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6138
			     x:(self extent x - (self font widthOf:s))
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6139
			     y:(self extent y + (self font ascent)).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6140
	]
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6141
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6142
    super endPage.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6143
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6144
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6145
startPage
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6146
    "starts a new page
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6147
     if the current page is not closed by endPage, a endPage is forward to the device"
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6148
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6149
    needsEndOfPage ifTrue:[
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6150
	self endPage.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6151
    ].
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6152
    super startPage.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6153
    needsEndOfPage := true.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6154
    pageCounter := pageCounter + 1.
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6155
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6156
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6157
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'queries'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6158
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6159
pixelPerInch
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6160
    ^ Point x:(self pixelsPerInchOfScreenWidth)
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6161
	    y:(self pixelsPerInchOfScreenHeight).
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6162
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6163
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6164
resolution
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6165
    ^ self pixelPerInch
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6166
! !
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6167
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6168
!WinPrinterContext class methodsFor:'documentation'!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6169
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6170
version
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6171
    ^ '$Header$'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6172
!
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6173
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6174
version_CVS
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6175
    ^ '$Header$'
7e5528572373 Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3818
diff changeset
  6176
! !