examp/classes/gui.inc

   1
   2 unit GUI: IIUWGRAPH class;
   3 const
   4       c_white=15,c_yellow=14,c_rose=13,c_red=12,
   5       c_turq=11,c_green=10,c_blue=9,c_darkgrey=8,
   6       c_lightgrey=7,c_brown=6,c_violet=5, c_darkred=4,
   7       c_darkturq=3,c_darkgreen=2,c_darkblue=1,
   8      c_black=0;
   9
  10 var res:array_of char, cursor_x,cursor_y:integer;
  11
  12 unit GUI_Clear:procedure;
  13 begin
  14  call cls;
  15 end GUI_Clear;
  16
  17 unit GUI_ClearArea:procedure(x1,y1,w,h:integer);
  18 begin
  19  res:=hfont8(312,x1,y1,w,"",h,0,0);
  20 end GUI_ClearArea;
  21
  22
  23 unit GUI_Point:procedure(x,y,col:integer);
  24 begin
  25  call color(col);
  26  call point(x,y);
  27 end GUI_Point;
  28
  29 unit GUI_Move:procedure(x,y:integer);
  30 begin
  31  cursor_x:=x;
  32  cursor_y:=y;
  33 end GUI_Move;
  34
  35 unit GUI_Line:procedure(x1,y1,x2,y2,col:integer);
  36 begin
  37  res:=hfont8(310,x1,y1,x2,"",y2,col,0);
  38 end GUI_Line;
  39
  40 unit GUI_LineTo:procedure(x,y,col:integer);
  41 begin
  42  res:=hfont8(310,cursor_x,cursor_y,x,"",y,col,0);
  43 end GUI_LineTo;
  44
  45 unit GUI_Rect:procedure(x1,y1,x2,y2,fcol,icol:integer);
  46 begin
  47  res:=hfont8(311,x1,y1,x2,"",y2,fcol,icol);
  48 end GUI_Rect;
  49
  50 unit GUI_Ellipse:procedure(x,y,a,b,sa,ea,fcol,icol:integer);
  51 begin
  52  call color(icol);
  53  call cirb(x,y,a,b,sa,ea,icol,1);
  54  call color(fcol);
  55  call cirb(x,y,a,b,sa,ea,fcol,0);
  56 end GUI_Ellipse;
  57
  58 unit GUI_WriteInt:procedure(x,y,i,fcol,bcol:integer);
  59 begin
  60  res:=hfont8(300,x,y,i,"",fcol,bcol,0);
  61 end GUI_WriteInt;
  62
  63 unit GUI_WriteChar:procedure(x,y:integer;c:char;fcol,bcol:integer);
  64 begin
  65  res:=hfont8(301,x,y,ord(c),"",fcol,bcol,0);
  66 end GUI_WriteChar;
  67
  68
  69 unit GUI_WriteReal:procedure(x,y:integer;r:real;
  70                                             fcol,bcol:integer);
  71 var  rr,i:real,int,frac:integer;
  72 begin
  73  int:=entier(r);
  74  rr:=r-int;
  75  i:=1.0;
  76  while rr-entier(rr)>0 do
  77   i:=i*10.0;
  78   rr:=r*i;
  79 od;
  80  frac:=entier(r*i-int*i);
  81  res:=hfont8(302,x,y,int,"",frac,fcol,bcol);
  82 end GUI_WriteReal;
  83
  84
  85
  86 unit GUI_WriteText:procedure(x,y:integer;t:array_of char;
  87                                               fcol,bcol:integer);
  88 var i:integer;
  89 begin
  90 if t<>none then
  91 res:=hfont8(1000,0,0,0,"",0,0,0);
  92 for i:=lower(t) to upper(t) do
  93  res:=hfont8(1001,ord(t(i)),0,0,"",0,0,0);
  94 od;
  95  res:=hfont8(303,x,y,fcol,"",bcol,0,0);
  96 fi;
  97 end GUI_WriteText;
  98
  99 unit GUI_ReadText:function(x,y,
 100                              fcol,bcol:integer):array_of char;
 101 begin
 102 result:=hfont8(-304,x,y,fcol,"",bcol,0,0);
 103 end GUI_ReadText;
 104
 105
 106 unit GUI_ReadInt:function(x,y,fcol,bcol:integer):integer;
 107 begin
 108 res:=hfont8(-305,x,y,fcol,"",bcol,0,0);
 109 result:=ord(res(0));
 110 end GUI_ReadInt;
 111
 112 unit GUI_ReadChar:function(x,y,
 113                              fcol,bcol:integer):char;
 114 begin
 115 res:=hfont8(-306,x,y,fcol,"",bcol,0,0);
 116 result:=res(0);
 117 end GUI_ReadChar;
 118
 119 unit GUI_ReadReal:function(x,y,
 120                              fcol,bcol:integer):real;
 121 var p1,p2,i:real;
 122 begin
 123 res:=hfont8(-307,x,y,fcol,"",bcol,0,0);
 124 p1:=ord(res(0));
 125 p2:=ord(res(1));
 126 while  entier(p2)>0 do
 127 p2:=p2/10.0;
 128 od;
 129 result:=p1+p2;
 130 end GUI_ReadReal;
 131
 132
 133 unit GUI_PutImgFile:procedure(x,y:integer;fname:string);
 134 begin
 135  res:=hfont8(308,x,y,0,fname,0,0,0);
 136 end GUI_PutImgFile;
 137
 138 unit GUI_GetImg:function(x,y,w,h:integer):array_of integer;
 139 begin
 140  call move(x,y);
 141  result:=getmap(x+w,y+h);
 142 end GUI_GetImg;
 143
 144 unit GUI_PutImg:procedure(x,y:integer;map:array_of integer);
 145 begin
 146  call move(x,y);
 147  call putmap(map);
 148 end GUI_PutImg;
 149
 150 unit GUI_KillImg:procedure(map:array_of integer);
 151 begin
 152 if map<>none then
 153  res:=hfont8(309,map(1),0,0,"",0,0,0);
 154 fi;
 155 end GUI_KillImg;
 156
 157 unit GUI_MousePressed:MOUSE
 158               procedure(INOUT x,y,btn:integer);
 159 var l,p,r:integer,e:boolean;
 160 begin
 161  e:=getpress(x,y,l,p,r,btn);
 162 end GUI_MousePressed;
 163
 164 unit GUI_KeyPressed:function:integer;
 165 begin
 166  result:=inkey;
 167 end GUI_KeyPressed;
 168
 169 begin
 170 cursor_x:=0;cursor_y:=0;
 171 end GUI;
 172
 173 \0\0