examples/pataud/mon.log

   1 Program systemefenetrage;\r
   2 \r
   3 (***************************************************************************)\r
   4 (* Programme de syst\8ame de fenetrage avec boutons et gestion de la souris  *)\r
   5 (* PATAUD Fr\82d\82ric & PEYRAT Fran\87ois                             1993/1994 *)\r
   6 (***************************************************************************)\r
   7 \r
   8 Begin\r
   9 Pref iiuwgraph block\r
  10 \r
  11   Begin\r
  12   Pref mouse block\r
  13 \r
  14 var\r
  15    f : file,\r
  16    w : windows;\r
  17 \r
  18     Unit Line : procedure (x1,y1,x2,y2,c : integer);\r
  19     Begin\r
  20          call color(c);\r
  21          call move(x1,y1);\r
  22          call draw(x2,y2);\r
  23     End Line;\r
  24 \r
  25     Unit Rectangle : procedure (x1,y1,x2,y2,c : integer);\r
  26     Begin\r
  27         writeln(f,x1,y1,x2,y2,c);\r
  28          call color(c);\r
  29          call move(x1,y1);\r
  30          call draw(x2,y1);\r
  31          call draw(x2,y2);\r
  32          call draw(x1,y2);\r
  33          call draw(x1,y1);\r
  34    End Rectangle;\r
  35 \r
  36    Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer);\r
  37    var i : integer;\r
  38    Begin\r
  39     for i:=y1 to y2\r
  40     do\r
  41       call Line(x1,i,x2,i,c);\r
  42     od\r
  43    End Rectanglef;\r
  44 \r
  45    Unit windows : class;\r
  46    var\r
  47       ind,indc,x1,y1,x2,y2: integer,\r
  48       rgs_pere : rgs,\r
  49       menubar : menu;\r
  50 \r
  51         unit menu : class(nom : string,action : integer,suiv : menu);\r
  52         var\r
  53             p_rgs : rgs,\r
  54             x1,y1,x2,y2,c : integer;\r
  55 \r
  56             unit affiche : procedure;\r
  57             begin\r
  58                  if suiv =/= none\r
  59                  then\r
  60                        call suiv.affiche;\r
  61                  fi;\r
  62                  call rectanglef(x1+1,y1+1,x2-1,y2-1,7);\r
  63                  call color(c);\r
  64                  call move(x1+10,y2-15);\r
  65                  call outstring(nom);\r
  66                  call rectangle(x1,y1,x2,y2,c);\r
  67             end affiche;\r
  68 \r
  69         begin\r
  70           c := indc;\r
  71           indc := indc + 1;\r
  72           x1 := 20 + ind;\r
  73           y1 := 5;\r
  74           x2 := 120 + ind;\r
  75           y2 := 25;\r
  76           p_rgs := rgs_pere;\r
  77           while p_rgs.suiv =/= none do p_rgs := p_rgs.suiv;od ;\r
  78           p_rgs.suiv := new rgs(x1,y1,x2,y2,action);\r
  79           ind := ind + 120;\r
  80         end menu;\r
  81 \r
  82         unit gestionnaire : procedure;\r
  83         var\r
  84             choix,h,v,p,b:integer,\r
  85             l,r,c:boolean;\r
  86         begin\r
  87              call showcursor;\r
  88              do\r
  89                 l,r := false;\r
  90                (* call status(h,v,l,r,c);\r
  91                if r then exit fi;\r
  92                p:=0;\r
  93                call status(h,v,l,r,c);*)\r
  94                while not l and not r do call getpress(0,h,v,p,l,r,c);od;\r
  95                 if r then exit fi;\r
  96                if p <>0 then\r
  97                 call rectangle(50,50,h,v,3);\r
  98                choix := 0;\r
  99                choix := quoi(h,v);\r
 100                 writeln(f,"choix : ",choix);\r
 101                case choix\r
 102                 when 1 : call rectangle(200,200,250,250,3);\r
 103                         writeln(f,"r1 ");\r
 104                 when 2 : call rectangle(160,160,300,300,3);\r
 105                         writeln(f,"r2");\r
 106                 when 3 : call rectangle(120,120,350,350,3);\r
 107                         writeln(f,"r3");\r
 108                esac;\r
 109                fi;\r
 110                 p := 0;\r
 111             od;\r
 112         end;\r
 113 \r
 114         unit quoi : function (h,v : integer) : integer;\r
 115         var\r
 116            p_rgs : rgs,\r
 117            resultat : integer,\r
 118            a,b,c : boolean;\r
 119         begin\r
 120              p_rgs := rgs_pere;\r
 121              p_rgs := p_rgs.suiv;\r
 122              do\r
 123                a:=(p_rgs.x1 < h and p_rgs.x2> h ) ;\r
 124                b:=(p_rgs.y1 < v and p_rgs.y2 > v) ;\r
 125                c:= a and b;\r
 126                if c then\r
 127                    result := p_rgs.code;\r
 128                    return;\r
 129                fi;\r
 130                if p_rgs.suiv =/= none\r
 131                then\r
 132                    p_rgs:=p_rgs.suiv;\r
 133                else\r
 134                    result := 0;\r
 135                    return;\r
 136                fi;\r
 137              od;\r
 138         end quoi;\r
 139 \r
 140         unit rgs : class(x1,y1,x2,y2,code : integer);\r
 141         var\r
 142            suiv : rgs;\r
 143         begin\r
 144              call rectangle(x1,y1+100,x2,y2+100,15);\r
 145         end rgs;\r
 146 \r
 147         unit affiche : procedure(x1,y1,x2,y2 : integer);\r
 148         begin\r
 149           call rectangle(x1,y1,x2,y2,1);\r
 150           call rectanglef(x1+3,y1+3,x2-3,30,8);\r
 151           call rectangle(x1+3,33,x2-3,y2-3,9);\r
 152         end affiche;\r
 153 \r
 154    begin\r
 155         ind := 0;\r
 156         indc := 4;\r
 157         x1 := 0;\r
 158         y1 := 0;\r
 159         x2 := 639;\r
 160         y2 := 479;\r
 161         call affiche(x1,y1,x2,y2);\r
 162         rgs_pere := new rgs(0,0,0,0,0);\r
 163         inner;\r
 164         call gestionnaire;\r
 165    End windows;\r
 166 \r
 167    Unit monwindows : windows class;\r
 168    begin\r
 169         menubar := new menu("troisieme",3,\r
 170                    new menu("deuxieme",2,\r
 171                    new menu("premier",1,none)));\r
 172         call menubar.affiche;\r
 173    End monwindows;\r
 174 \r
 175 \r
 176 \r
 177 \r
 178        Begin\r
 179             open(f,text,unpack("testing"));\r
 180            call rewrite(f);\r
 181             call gron(1);\r
 182             w := new monwindows;\r
 183             call groff;\r
 184             kill(f);\r
 185        end;\r
 186   end;\r
 187 end.\r