doc/iuwgraf3.txt

   1 \r
   2 unit IIUWGRAPH: class;\r
   3 \r
   4 {    this predefined class enables basic graphic operations\r
   5       for DOS machines based on 486 or 386 processors }\r
   6 \r
   7 {    this document gives the specification of new version of IIUWGRAPH \r
   8         class made in October 1994 by Frederic Pataud à Pau\r
   9  }\r
  10 \r
  11 {    the early versions of library IIUWGRAPH have been elaborated by \r
  12        Piotr Carlsson, Miroslawa Milkowska, Janina Jankowska, \r
  13        Michal Jankowski  at  Institute of Informatics, \r
  14        University of Warsaw 1987,\r
  15        and added to Loglan system by Danuta Szczepanska 1987, \r
  16  \r
  17        the recent versions were done at LITA, Pau,\r
  18        by\r
  19        Pawel Susicki  (1991) for Unix,\r
  20        Sebastien Bernard (1992) for ATARI, see a separate document,\r
  21        Eric Becourt et Jerôme Larrieu (1993) for Unix and Xwindows, see a \r
  22         separate document on Xiiuwgraf ,\r
  23  \r
  24  \r
  25 \r
  26 fait à Pau, le 15 Novembre 1994,  par Andrzej Salwicki, LITA}\r
  27 \r
  28 { the predefined class IIUWGRAPH is included in all versions of interpreter of \r
  29 Loglan, with the exception of the present version of interpreter for VAX/VMS.}\r
  30  \r
  31 \r
  32 \r
  33 hidden   MaxX, MaxY,  current_X, current_Y, is_graphic_On,      \r
  34               current_Colour, current_Background_Colour,  current_Style,\r
  35               current_Palette,  current_Pattern ;\r
  36 \r
  37 \r
  38                \r
  39 const  MaxX =           \r
  40           MaxY =           \r
  41 \r
  42 {    the screen's coordinates are\r
  43        \r
  44        (0,0)   ---------------------->  (MaxX,0)\r
  45            ¦\r
  46            ¦\r
  47            ¦\r
  48           V\r
  49        (0, MaxY)                            (MaxX,MaxY)\r
  50 \r
  51 }\r
  52 \r
  53 \r
  54 var  currentDriver : integer,                     { see NOCARD below } \r
  55        current_X, current_Y:  integer         { it is the current position }\r
  56        is_graphic_On:  Boolean,    { evidently tells whether we are in                  \r
  57                         graphics mode }\r
  58        current_Colour : integer,                { }\r
  59        current_Background_Colour : integer,\r
  60        current_Style : integer,         { }\r
  61        current_Palette : integer,\r
  62        current_Pattern \r
  63 \r
  64 unit GRON : procedure (i: integer);\r
  65       {  procedure sets the monitor in graphic mode and clears the  buffer\r
  66         of screen. The parameter determines the resolution and the number of \r
  67         colours.\r
  68 The user should assure that the resolution chosen should correspond to that \r
  69 which set by means of command\r
  70 SET go32 drivers {path}<driver.file> <width> <height><noColours>\r
  71 eg.\r
  72 set go32 drivers c:\loglan\svga\drivers\vesa.grn gw 1024 gh 480 nc 256\r
  73     An execution of instruction call gron(i) must precede any of the \r
  74 graphic commands described below.\r
  75        }\r
  76 \r
  77 unit GROFF : procedure;\r
  78       {  the procedure sets the monitor in the text mode filling it with \r
  79         spaces.\r
  80          DO NOT FORGET to set the monitor in the text mode before \r
  81 you terminate  your program\r
  82        }\r
  83 \r
  84 unit NOCARD : function : integer;\r
  85       { the value given by this function determines the type of the currently used \r
  86 monitor and it is equal to\r
  87             1   for Hercules mono card,\r
  88         2       for IBM CGA color\r
  89         3       for IBM CGA mono 320 x 200\r
  90         4       for IBM CGA mono 640 x 200\r
  91         5       for EGA/VGA card\r
  92            6          for ATARI STE\r
  93            7          for  Unix versions equipped with XWindows\r
  94            You can not call the function nocard before GRON sets the graphic mode\r
  95        }\r
  96 \r
  97 unit CLS : procedure;\r
  98        { the screen will be cleared and filled with colour 0  }\r
  99 \r
 100 \r
 101 unit VIDEO : procedure( A: array of integer);\r
 102        { this procedure can not be applied with egaint = EGA/VGA card }\r
 103         { the worktime buffer will be associated with the array A.\r
 104             A call of VIDEO does not change the contents of the buffer. \r
 105             All subsequent calls of the procedures modifying the screen will \r
 106             concern the array A. The screen does not change.\r
 107             A ready image can be moved to the screen with the help of               \r
 108         GETMAP/PUTMAP procedures or it can be stored on disk.\r
 109             The array should have 16 kBytes for IBM CGA card or \r
 110           32 kBytes for Hercules card.}\r
 111 \r
 112 { PROCEDURES  CONTROLLING THE COLOURS }\r
 113 \r
 114 unit COLOR : procedure(co : integer);\r
 115 {               sets current color to co \r
 116         for monochrome displays, 0 means black, non-0 - white\r
 117         for color displays, 0 means background\r
 118      see PALLET\r
 119 }      \r
 120 \r
 121 unit STYLE : procedure(styl : integer);\r
 122 {       sets style of lines and fill shades to a combination\r
 123         of current color and background color (for mono -\r
 124         white and black, respectively) according to 5 predefined\r
 125         patterns:\r
 126 \r
 127                 0       ....\r
 128                 1       ****\r
 129                 2       ***.\r
 130                 3       **..\r
 131                 4       *.*.\r
 132                 5       *...\r
 133 \r
 134         where   '*' means current color,  '.' background colour\r
 135 When drawing the segments the subsequent pixels will have colour determined \r
 136 by cyclic application of style pattern. The first and the last pixels of a segment \r
 137 will have always current colour.\r
 138 When filling contours the given style will be applied to horizontal lines with even \r
 139 coordinate. The style for odd lines is determined automatically.\r
 140 The same applies for perpendicular lines.\r
 141 }\r
 142 \r
 143 \r
 144 unit BORDER : procedure (background_Colour: integer);\r
 145         \r
 146         {  sets actual background color to i  ( i = 0,1,...,15 )  }\r
 147 \r
 148 \r
 149 unit PALLET : procedure (nr : integer);\r
 150         {\r
 151 \r
 152 the codes of colors are as follows\r
 153                 0       black\r
 154                 1       blue dark\r
 155                 2       green dark\r
 156                 3       turquoise dark\r
 157                 4       red dark\r
 158                 5       violet\r
 159                 6       brown\r
 160                 7       grey light\r
 161                 8       grey dark        \r
 162                 9       blue\r
 163                 10      green\r
 164                 11      turquoise\r
 165                 12      red light\r
 166                 13      rose\r
 167                 14      yellow\r
 168                 15      white\r
 169   \r
 170       }\r
 171 \r
 172 \r
 173 \r
 174 { PROCEDURES CONTROLLING POSITION }\r
 175 \r
 176 unit MOVE : procedure (x,y :integer);\r
 177         { procedure MOVE sets the current position on the screen on the pixel \r
 178         with coordinates\r
 179              x  - column,\r
 180              y - line   }\r
 181          { precondition of  MOVE:\r
 182                  0*x*MaxX  & 0*y*MaxY \r
 183           }\r
 184 \r
 185 unit INXPOS : function: integer;\r
 186        { function INXPOS returns the x coordinate of the current position }\r
 187 \r
 188 \r
 189 unit INYPOS : function : integer;\r
 190         { function INYPOS returns the y coordinate of the current position }\r
 191 \r
 192 \r
 193 unit PUSHXY : procedure;\r
 194 {       pushes current position, color & style onto the stack.\r
 195         The stack is kept internally, max depth is 16\r
 196 }\r
 197 \r
 198 \r
 199 unit POPXY: procedure;\r
 200 \r
 201 {       restores position, color & style from internal stack   }\r
 202 \r
 203 { Example\r
 204 unit DIAGONAL : procedure;\r
 205     var ix, iy : integer;\r
 206 begin\r
 207         call PUSHXY;\r
 208         ix := INXPOS;\r
 209         iy := INYPOS;\r
 210         call DRAW(ix+10, iy+10);\r
 211         call POPXY\r
 212 end DIAGONAL;\r
 213 }\r
 214 \r
 215 \r
 216 \r
 217 { PROCEDURES SERVING POINTS & LINES}\r
 218 \r
 219 unit POINT : procedure(x,y: integer);\r
 220 {               moves current position to pixel (x,y) and sets it to the current color \r
 221  }\r
 222 \r
 223 unit INPIX : function (x,y : integer) : integer;\r
 224         {       \r
 225                 moves to pixel (x,y) and returns its color setting;\r
 226         }\r
 227 \r
 228 \r
 229 unit DRAW : procedure( x,y : integer);\r
 230         {   \r
 231         draws a line from current screen position to (x,y);\r
 232         sets current position to (x,y);\r
 233         line is drawn in current color, with both terminal pixels\r
 234         always turned white ( non-background) for non-black\r
 235         ( non-background ) line color.\r
 236         Bresenham's algorithm is used, pixels belonging to the segment \r
 237         change their state depending on current colour and style.\r
 238         }\r
 239 \r
 240 unit intens: procedure(Size :integer; xCoord,yCoord:arrayof integer,            \r
 241                 Colour,Filled :integer); \r
 242 /* draw a polygon*/\r
 243 { draw a simple, closed polygon of Size points, the edges of the polygon go from \r
 244 (xCoord[i], yCoord[i]) to (xCoord[i+1], yCoord[i+1]) for i = 1, ..., Size-1\r
 245 The colour used will be Colour. The polygon will be filled iff Filled<>0.\r
 246 }\r
 247 \r
 248 unit CIRB : procedure (xi, yi, rx,ry : integer, alfa, beta : real,  \r
 249                                                  cbord, fill : integer);\r
 250 \r
 251         {\r
 252         draws a circle (or ellipse, depending on aspect value, see below),\r
 253         optionally filling its interior; \r
 254         does not preserve position;\r
 255         (xi,yi) -  are center coordinates,\r
 256         rx - radius in pixels (horizontally),\r
 257         ry - radius in pixels (perpendicularly),\r
 258         alfa, beta - starting & ending angles; if alfa=beta a full\r
 259                circle is drawn; values should be given in radians;\r
 260         cbord - border color,\r
 261         fill - if fill <>0, interior is filled in current style&color\r
 262         }\r
 263 \r
 264 unit hfill: procedure( x : integer);\r
 265         {  draw an horizontal line between the current position and\r
 266         (x,currentY) with the current color, after it change the current\r
 267         position to (x, currentY)\r
 268         }\r
 269 \r
 270 unit vfill: procedure( y : integer);\r
 271        {   draw a vertical line between the current position and\r
 272         (currentX,y) with the current color, after it change the current\r
 273         position to (currentX,y)\r
 274        }\r
 275 \r
 276 unit patern: procedure( x1,y1,x2,y2,c,b : integer);\r
 277       {    draw a rectangle between the points (x1,y1) and (x2,y2) with the\r
 278         color c (the current color is not change). if b=0 then the box is\r
 279         empty else it is filled.\r
 280        }\r
 281 \r
 282 { Procedures operating on bitmaps }\r
 283 \r
 284 unit GETMAP : function (x,y : integer) : arrayof integer;\r
 285                 {saves rectangular area between current position as\r
 286         top left corner and (ix,iy) as bottom right corner,\r
 287         including border lines;\r
 288         position remains unchanged.\r
 289         array of integer should have  \r
 290                 4+(rows**columns/8* *coeff)\r
 291         bytes. The coefficient coeff is 1 for Hercules, 2 for CGA, 4 for EGA\r
 292         card.\r
 293          ATTENTION: in DOS 286 environment a bigger size of the array may \r
 294         necessitate the use of loglan with the option H+, see also memavail \r
 295            }\r
 296 \r
 297 unit PUTMAP : procedure ( a: arrayof integer);\r
 298         {sets rectangular area of screen pixels to that saved\r
 299         by "getmap" in "iarray";\r
 300         same size is restored, with top left corner in current\r
 301         position;\r
 302         position remains unchanged.\r
 303         }\r
 304 \r
 305 unit ORMAP : procedure ( a : arrayof integer);\r
 306         {same as putmap, but saved bitmap is or'ed into screen\r
 307         rather than just set.\r
 308         }\r
 309 \r
 310 unit XORMAP : procedure ( a: arrayof integer);\r
 311         {same as putmap, but saved bitmap is xor'ed into screen\r
 312         rather than just set.\r
 313         }\r
 314 \r
 315 \r
 316 {Procedures operating on characters and strings}\r
 317 \r
 318 unit outstring: procedure(x,y: integer, s: string, back_col, front_col: integer);\r
 319    { x, y are the coordinates where to put the string,\r
 320       s     is the string to be shown, in front_col colour letters on the back_col \r
 321         colour background\r
 322     }\r
 323 \r
 324 unit  track: procedure( x,y,c,valeur : integer);\r
 325 \r
 326    {    write an integer value valeur at the position (x,y) with the color c.\r
 327          It does not change the current position nor the current color\r
 328    }\r
 329 \r
 330 unit inkey : function : integer;\r
 331 \r
 332     {     returns next character from keyboard buffer;\r
 333         0 is returned if buffer is empty;\r
 334         special keys are returned as negative numbers;\r
 335         ALT-NUM method may be used for entering character codes\r
 336         above 127 (this makes entering special keys 128-132\r
 337         impossible);\r
 338         if a character is returned, it is also removed\r
 339         from the buffer, so MS-DOS will not see it (CTRL-C!);\r
 340         typeahead is allowed, echo is suppressed.\r
 341    }\r
 342 \r
 343 unit HASCII : procedure(c: integer);\r
 344         {'xor's the character = chr(c) in a 8*8 box with top left corner\r
 345         in the current position;\r
 346         moves current position by (8,0);\r
 347         call hascii(0)- sets complete box to black ( =background ),\r
 348         with no change in position.\r
 349         BIOS ROM font for IBM color card is used. If the font\r
 350         table is not at F000:FA6E, the character will probably\r
 351         be unrecognizable, and most certainly wrong.\r
 352         For codes >127, table pointed to by interrupt vector 31\r
 353         is used. }\r
 354 \r
 355 \r
 356 \r
 357 unit hfont: function( x,y,lg,min,max,default,col_f,col_e,col_c : integer):              \r
 358                                                                   integer;\r
 359 \r
 360         {       arrange a small 1 line window for reading an integer value from this \r
 361 window,\r
 362 the position of the window corner is (x, y),\r
 363 the length of the window is lg characters,\r
 364 the value v should be greater than min and smaller than max,\r
 365 the default value read is default,\r
 366 the colour of the window is col_f,\r
 367 the colour of the digits is col_e,\r
 368 the colour of cursor is col_c\r
 369 \r
 370  reads in graphic mode an integer in the window which begins at the (x,y)\r
 371         position, window is lg caracteres long. the maximum length of the\r
 372         integer that is read is 10. there is a default value, a minimum value\r
 373         and a maximum value. the window is drawn with the col_f color, the  \r
 374         cursor is in the col_c color and the integer is writing in the col_e\r
 375         color. you can use 0..9,+,-,backspace,escape and return keys. }\r
 376 \r
 377 \r
 378 unit HPAGE : procedure(x,y,long: integer, A: arrayof char, back, front: integer);\r
 379         { this procedure arranges a 1-line high window in position x,y of length \r
 380         long in which a portion of text A is shown in colour front on the \r
 381         background colour back. \r
 382         Making use of  keys controlling the cursor {left, right, PgUp, PgDn}\r
 383         the user can scroll the text (horizontally) in the window. Pressing the \r
 384         Enter key terminates the procedure}         \r
 385 \r
 386 end IIUWGRAPH;\r
 387 \r
 388 \r
 389 \r
 390 \r
 391 unit MOUSE: class;\r
 392     \r
 393 {       init -lors de l'initialisation de la souris, on peut définir les événements qui vont faire réagir la fonction \r
 394 getpress; le premier et le deuxième paramètre représentent respectivement la souris et le clavier, si une valeur non \r
 395 nulle est donnée comme paramètre alors getpress réagira à l'événement.\r
 396 \r
 397         Une paire (1,1) va permettre de prendre en compte à la fois les événements de la souris et ceux du clavier; \r
 398 une paire (1,0) quand à elle ne prendra en compte que la souris. Pour une plus grande souplesse d'utilisation, il est \r
 399 possible lors du programme, après l'initalisation, de changer cette prise en compte, cela se fera par l'appel de la \r
 400 procedure getmovement, procédure ayant les mêmes paramètres (avec le même ordre) que la fonction init.\r
 401 \r
 402         Pour detecter les événements, on utilisa la fonction getpress, qui retourne un booléen indiquant la présence \r
 403 ou l'absence d'événement (respectivement les valeurs true et false). Il est bon de noter qu'ainsi définie la fonction \r
 404 getpress n'est pas bloquante. Les paramètres en retour sont soit nuls (pas d'événement) soit correspondent:\r
 405 \r
 406         bool:=getpress(v,p,h,l,r,c : integer);\r
 407                 v = position en y de la souris\r
 408                 p = keyboard status (Touche control_left,control_right, alt, alt_gr, shift_left, shift_right)\r
 409                 h = position en x de la souris\r
 410                 l  = touche clavier\r
 411                 r = flags\r
 412                 c = boutons de la souris (0=aucun, 1=gauche, 2=droite, 3=gauche et droite)\r
 413                         Nb: le bouton central n'est pas géré.\r
 414 \r
 415 NOTEZ BIEN! Lorsque les événements du clavier sont pris en compte dans le gestionnaire, il ne faut pas utiliser \r
 416 les fonctions d'entrées clavier readl, readln, hfont, hfont8, hpage, inkey,...) sous peine de plantage de \r
 417 l'ordinateur.\r
 418 }\r
 419 \r
 420     unit init: procedure(checkMouse, checkKeyboard: integer);\r
 421          { initializes the Mouse driver.\r
 422             tells which events will be checked:\r
 423             if checkMouse <>0 then the events of Mouse will be reported to getpress, see below otherwise ignored;\r
 424             if checkKeyboard <>0 then the events of Keyboard will be reported to getpress, otherwise ignored\r
 425                  Attention please!  While the events of the keyboard are taken under control by init or getmovement\r
 426                 do not use the functions or procedures: read, readln, hfont, hfont8, hpage, inkey that read keys\r
 427                 YOU RISK TO HANG YOUR SYSTEM!\r
 428          }\r
 429     end init\r
 430 \r
 431     unit getmovement: procedure(checkMouse, checkKeyboard: integer);\r
 432         tells which events will be checked:\r
 433             if checkMouse <>0 then the events of Mouse will be reported to getpress, see below otherwise ignored;\r
 434             if checkKeyboard <>0 then the events of Keyboard will be reported to getpress, otherwise ignored\r
 435                  Attention please!  While the events of the keyboard are taken under control by init or getmovement\r
 436                 do not use the functions or procedures: read, readln, hfont, hfont8, hpage, inkey that read keys\r
 437                 YOU RISK TO HANG YOUR SYSTEM!\r
 438     end getmovement;\r
 439 \r
 440     unit getpress: function(v,p,h,l,r,c : integer): Boolean;\r
 441         {  v =  y coordinate of the cursor,\r
 442             h =  x coordinate of the cursor,\r
 443             p =  keybord status control_left,control_right, alt, alt_gr, shift_left, shift_right\r
 444                     l  = code of key pressed\r
 445             r = flags\r
 446             c = buttons pressed (0=aucun, 1=gauche, 2=droite, 3=gauche et droite)\r
 447                         Nb: the middle button is not taken into account.\r
 448     end getpress\r
 449 \r
 450 \r
 451     unit showcursor: procedure;\r
 452         {the cursor becomes visible and follows the movements of the mouse}\r
 453     end showcursor;\r
 454 \r
 455     unit hidecursor: procedure;\r
 456         {the cursor becomes invisible}\r
 457     end hidecursor;\r
 458 \r
 459 end MOUSE;\r
 460 \r
 461 \r
 462 \r
 463 Enclosed you find a sample program\r
 464 \r
 465 Program SystemeGraph;\r
 466        (* by Frederic Pataud, October 1994 *)\r
 467 Begin\r
 468 Pref iiuwgraph block     (* inherit the graphic functions *)\r
 469  Begin\r
 470  Pref mouse block       (* inherit the mouse functions *)\r
 471 \r
 472 \r
 473    (*****************************************************************************)\r
 474    (*                   P r o g r a m  m e   P r i n c i p a l                  *)\r
 475    (*****************************************************************************)\r
 476    var v,p,h,i : integer,\r
 477        l,r,c : integer,\r
 478        rep : arrayof char,\r
 479        d : boolean,\r
 480        xx,yy : arrayof integer,\r
 481        status,code,x,y,flags,button : integer;\r
 482    \r
 483    Begin\r
 484      \r
 485      call gron(0);            (* enter the graphic mode *)\r
 486      call init(1,0);            (* initialize the mouse, disregard the keyboard events, check for mouse events *)\r
 487      \r
 488      call showcursor;           (* show cursor *)\r
 489      call patern(5,5,635,475,2,0);         (* make a frame around the screen *)\r
 490      call outstring(10,10,"x=",2,0);\r
 491      call outstring(100,10,"y=",2,0);\r
 492      call outstring(10,30,"status = ",2,0);\r
 493      call outstring(10,50,"code   = ",2,0);\r
 494      call outstring(10,70,"flags  = ",2,0);\r
 495      call outstring(10,90,"button = ",2,0);\r
 496      call patern(100,210,300,320,3,1);         (* make a rectangle filled in colour 3 *)\r
 497 \r
 498      array xx dim (1:6);\r
 499      array yy dim (1:6);\r
 500      xx(1):=410; yy(1):=10;\r
 501      xx(2):=450; yy(2):=30;\r
 502      xx(3):=460; yy(3):=50;\r
 503      xx(4):=430; yy(4):=80;\r
 504      xx(5):=420; yy(5):=40;\r
 505      xx(6):=480; yy(6):=30;\r
 506      call intens(6,xx,yy,8,1);          (* show a polygon filled*)\r
 507      for i:=1 to 6\r
 508       do\r
 509        yy(i):=yy(i)+100;\r
 510       od;\r
 511      call intens(6,xx,yy,15,0);         (* show another polygon empty *)\r
 512      \r
 513      call cirb(500,300,50,40,100,3500,10,0);    (* draw an empty pie or camembert *)\r
 514      call cirb(400,400,40,40,600,4000,11,1);     (* draw a filled pie *)\r
 515 \r
 516 \r
 517      i:=hfont(100,350,6,-9999999,9999999,500,9,0,15);      (* read integer from a window *)\r
 518      call hpage(100,400,10,unpack("Il fait beau dans ma verte campagne"),9,0);   (* show text *)\r
 519      rep:=hfont8(100,430,10,80,unpack("tototutu"),9,0,15);              (* read text *)\r
 520      \r
 521      call getmovement(1,1);           (* take into consideration both key events and mouse events *)\r
 522      \r
 523      do\r
 524       d:=getpress(v,p,h,l,r,c);         (* ask about an event *)\r
 525       if (d)\r
 526       then call outstring(10,400,"Event",2,0);\r
 527            call patern(80,25,130,100,0,1);\r
 528            call track(40,10,v,0,4);             (* print integer *)\r
 529            call track(140,10,p,0,4);\r
 530            call track(80,30,h,0,4);\r
 531            call track(80,50,l,0,4);\r
 532            call track(80,70,r,0,4);\r
 533            call track(80,90,c,0,4);\r
 534            if((h=164 and l=27) or (c=3))                 (* exit if either two buttons were pressed c=3 or Ctrl+Esc key *)\r
 535            then exit;\r
 536            fi;\r
 537       fi;\r
 538      od;\r
 539      call groff;                                (* leave the graphic mode and return to the text mode *)\r
 540      writeln("i=",i);\r
 541      for i:=lower(rep) to upper(rep)\r
 542       do\r
 543        write(rep(i));\r
 544       od;\r
 545      writeln;\r
 546    End\r
 547  End\r
 548 End.\r
 549 \r
 550 \r
 551 \r
 552 \r
 553 \r
 554 \r
 555 \r
 556 \r
 557 \r
 558 \r