% Mr. M
% December 20, 2000
% Page 340, #17  Keypad to binary

setscreen("graphics:vga")
var xm,ym,b,q,r:int
var binary:string

procedure keys
  locatexy(120,120)
  put "1"
  drawbox(100,100,140,140,4)
  locatexy(170,120)
  put "2"
  drawbox(150,100,190,140,4)
  locatexy(220,120)
  put "3"
  drawbox(200,100,240,140,4)
  locatexy(120,170)
  put "4"
  drawbox(100,150,140,190,4)
  locatexy(170,170)
  put "5"
  drawbox(150,150,190,190,4)
  locatexy(220,170)
  put "6"
  drawbox(200,150,240,190,4)
  locatexy(120,220)
  put "7"
  drawbox(100,200,140,240,4)
  locatexy(170,220)
  put "8"
  drawbox(150,200,190,240,4)
  locatexy(220,220)
  put "9"
  drawbox(200,200,240,240,4)
  locatexy(305,120)
  put "Quit"
  drawbox(300,100,340,140,4)
end keys

procedure conv(a:int)
  delay(500)
  var t:int
  t:=a
  locatexy(100,450)
  put a
  for i:1..4
    r:=t mod 2
    if r=1 then
      binary:=binary+"1"
    else
      binary:=binary+"0"
    end if
    t:=t div 2
 end for
 locatexy(100,400)
 for decreasing i:4..1
  put binary(i)..
 end for
end conv

% Main program

keys
loop
  binary:=""
  mousewhere(xm,ym,b)
  if xm>100 and xm<140 and ym>100 and ym<140 and b=1 then
    q:=1
    conv(q)
  end if
  if xm>150 and xm<190 and ym>100 and ym<140 and b=1 then
    q:=2
    conv(q)
  end if
  if xm>200 and xm<240 and ym>100 and ym<140 and b=1 then
    q:=3
    conv(q)
  end if
  if xm>100 and xm<140 and ym>150 and ym<190 and b=1 then
    q:=4
    conv(q)
  end if
  if xm>150 and xm<190 and ym>150 and ym<190 and b=1 then
    q:=5
    conv(q)
  end if
  if xm>200 and xm<240 and ym>150 and ym<190 and b=1 then
    q:=6
    conv(q)
  end if
  if xm>100 and xm<140 and ym>200 and ym<240 and b=1 then
    q:=7
    conv(q)
  end if
  if xm>150 and xm<190 and ym>200 and ym<240 and b=1 then
    q:=8
    conv(q)
  end if
  if xm>200 and xm<240 and ym>200 and ym<240 and b=1 then
    q:=9
    conv(q)
  end if
  if xm>300 and xm<340 and ym>100 and ym<140 and b=1 then
    exit
  end if
end loop