/*                                                         */
    /*              A r c s   a n d   A r c h e s              */
    /*            L i n e s   a n d   C o l o u r s            */
    /*        A Stained-Glass Window Designer's Studio         */
    /*                                                         */
    /*        In ARexx                 By John Collett         */
    /*                                                         */
    
    signal on syntax ; signal on error
    if arg() ~= 0 then signal Finish
    if ~show('l','rexxarplib.library') then do
     check = addlib('rexxsupport.library',0,-30,0) 
     check = addlib('rexxarplib.library',0,-30,0) 
     end      
     call SetPointer(hairline)        /* See below for conditions */
                                        
    address AREXX '"call CreateHost(HO, PORT)"'    
    if ~show('Ports',HO) then address command 'WaitForPort HO' 
    flags = 'BORDERLESS+WINDOWCLOSE'
    idcmp = 'GADGETUP+MOUSEBUTTONS+CLOSEWINDOW+VANILLAKEY+ACTIVEWINDOW'
    Wh = 220 ; left. = 0 ; right. = 0  /* Wh = Window Height */
    call OpenWindow(HO,0,12,640,Wh,idcmp, flags) 
    call openport(PORT) ; call ActivateWindow(HO)
    call FRect(20,0,640,10,0) ; call Trig() ; dithers = 0
    do i = 0 to 12 ; slot.i = 12*i ; end
    call FRect(30,20,216,60,2)
    call SetFont(HO,'topaz.font',11)
    call BPen(2) ; call pat(34,34,"   Design your own    ")
                   call pat(34,50," Stained-Glass Window ")
    call SetFont(HO,'topaz.font',8) ; call BPen(0)
    call Ogive(120,80,70,100) ; call Sample()
 
    call AddGadget(HO,602,slot.2,1,"Draw",'%l %d %x %y')
    call Ln(620,slot.2,620,slot.3-3,3)
    call AddGadget(HO,602,slot.4,3,"Fill",'%l %d %x %y')
    call AddGadget(HO,602,slot.7,4,"Area",'%l %d %x %y')
    call AddGadget(HO,602,slot.9,5,"    ",'%l %d %x %y')
    call AddGadget(HO,602,slot.10,6,"Arch",'%l %d %x %y')
    call AddGadget(HO,602,slot.11,7,"Save",'%l %d %x %y')
    call AddGadget(HO,602,slot.12,8,"    ",'%l %d %x %y')
    call Squeeze(9,'Ogive') ; call Squeeze(12,'Clear')
    call ModifyHost(HO,'MOUSEBUTTONS','%l %c %x %y')
    call APen(1) ; ogno = 1 ; call Ogive(400,120,20,160) 
    left.1 = 338;top.1=22;right.1=460;hite.1=180

    do forever
      call waitpkt(PORT) ; p = getpkt(PORT)
      if p ~== NULL() then do
        i = getarg(p) ; t = reply(p, 0)
        parse var i class gno rest
        select
          when class = 'CLOSEWINDOW' then signal 'Finish'
          when class = 'ACTIVEWINDOW' then call FRect(20,0,640,10,0)  
          when class = 'GADGETUP' then  
           select
            when gno = 1 then call DrawLine()
            when gno = 3 then call Fill()
            when gno = 4 then call Area()
            when gno = 5 then call OgiveRect()
            when gno = 6 then call Arc()
            when gno = 7 then call SaveIt()
            when gno = 8 then call Clear()
            otherwise
    
            end
          when class = 'MOUSEBUTTONS' then call Coords()
          otherwise
          end  /* of 'select'         */
        end    /* of 'if ... then do' */
      end      /* of 'do forever'     */
  
    Finish:
      call CloseWindow(HO) ;  call SetPointer(arrow)
      exit
      syntax: say 'Syntax : ' errortext(rc) '. Line 'sigl ; signal 'Finish'
      error: say "Error " rc sigl ; signal 'Finish'
   
    pat:       
      if arg() = 4 then call APen(arg(4))
      call Move(HO,arg(1),arg(2)) ; call Text(HO,arg(3))
     return

    APen: call SetAPen(HO,arg(1)) ; return
    BPen: call SetBPen(HO,arg(1)) ; return

    Squeeze: 
     call APen(1) ; a = arg(1) ; o = arg(2) ; g = slot.a + 7
     do i = 1 to 5 ; call pat(595+i*7,g,substr(o,i,1)) ; end
     return

    Ln: if arg() = 5 then call APen(arg(5))
     call Move(HO,arg(1),arg(2)) ; call Draw(HO,arg(3),arg(4)) ; return

    FRect:
     call APen(arg(5)) ; call RectFill(HO,arg(1),arg(2),arg(3),arg(4))
     call APen(1)
     return
    
    Clear:
     call FRect(0,0,640,Wh,0)
     call RefreshGadgets(HO) ; dithers = 0 ; ogno = 0
     call Squeeze(9,'Ogive') ; call Squeeze(12,'Clear')
     call Ln(620,slot.2,620,slot.3-3,3) ; call APen(1)
     return
    
    ClearSlot:  
     do cs = 1 to arg()
      g = arg(cs) ; g = slot.g - 1 ; call FRect(600,g,640,g+11,0) ; end
      call RefreshGadgets(HO)
     return
    
    Coords:
      parse var i class state x y 
      if state ~= 'SELECTDOWN' then call Showem(x,y)
      return
    Showem: call pat(604,10,arg(1) ' ') ; call pat(604,18,strip(arg(2)) ' ') 
      return    

    Ogive:
     centre = arg(1) ; wid = arg(2) ; top = arg(3) ; hite = arg(4)
     left = centre - wid%2 ; right = centre + wid%2
     call Og() ; wid = wid - 12 ; top = top + 4 ; hite = hite-7
     left = left+6 ; right = right-6
     call Og() ; call Flo(centre,top+hite+2)
     call Flo(centre,top+10,2) ; call APen(1)
     return

    Og:
     rad = (wid*3)%4 ; rad2 = rad%2 ; y = top+rad2
     prevleft = left ; prevright = right ; prevy = y
     dx2 = left ; dy2 = right
     do i = 1 to 9
      c = c.i ; s = s.i ; dx1 = left+rad-trunc(rad*c,2)
      dx2 = right-rad+trunc(abs(rad*c),2) ; dy = y-trunc(rad2*s,2)
      if dx1<=dx2 then do
       call Ln(prevleft,prevy,dx1,dy) ; call Ln(prevright,prevy,dx2,dy)
       prevleft = dx1 ; prevright = dx2 ; prevy = dy
       end
      else do
       fx = prevleft + abs((prevright-prevleft)%2) ; dy = prevy - 1
       call Ln(prevleft,prevy,fx,dy) ; call Ln(prevright,prevy,fx,dy)
       end 
     end
     call Ln(left,y,left,top+hite)
     call Draw(HO,right,top+hite) ; call Draw(HO,right,y)
     return
    
    Arc:
     call clear()
     call APen(0) ; call RectFill(HO,590,1,640,142) ; call APen(1)
     call BPen(2) ; call pat(300,8,'  Technical Notes  ') ; call BPen(0)
     call DrawEllipse(HO,100,70,100,50) ; call DrawEllipse(HO,100,70,92,46)  
     call APen(2)
     call DrawEllipse(HO,175,70,92,46) ; call DrawEllipse(HO,175,70,100,50)
     call Cross(100,70) ; call Cross(175,70)
     call Ln(75,70,75,170,2) ; call Ln(83,70,83,170,2)
     call Ln(192,70,192,170,1) ; call Ln(200,70,200,170,1)
     call Ln(75,170,83,170,2) ; call Ln(192,170,200,170,1)
     call APen(3) 
     do f = 77 to 137 by 20 
      call Flo(80,f) ; call Flo(196,f) ; end
     call Flo(138,26)
     call pat(300,18,"The Gothic Arch (Colour 3) is here",1)
     call pat(300,27,"shown to be produced by overlapping")
     call pat(300,36,"pairs of concentric circles.")
     call pat(300,45,"Crosses mark their centres.")
     call pat(300,54,"Tangents from the circles drop")
     call pat(300,63,"to form the uprights for the arch.")
     call Ln(290,72,640,72) ; call Ln(290,72,290,180)
     call Ln(0,180,290,180)
     call pat(300,90, "In this program, since only a small arc")
     call pat(300,99, "was needed, I looked up and stored a")
     call pat(300,108,"few SINE and COS values, enough to pro-")
     call pat(300,117,"duce the shape below.  The calculated")
     call pat(300,126,"points are shown by coloured pixels,")
     call pat(300,135,"slightly offset for visibility.")
     call Cross(450,200) ; call Move(HO,350,200) ; call APen(1)
     do i = 1 to 9
      dx1 = 450-100*c.i ; dy = 200-50*s.i ; call Draw(HO,dx1,dy)
      call APen(7) ; call WritePixel(HO,dx1-1,dy-1) ; call APen(1) ; end    
     return

    Trig: 
     c. = 0 ; s. = 0 ; c.1 = 0.99 ; s.1 = 0.15 ; c.2 = 0.96 ; s.2 = 0.29
     c.3 = 0.91 ; s.3 = 0.43 ; c.4 = 0.84 ; s.4 = 0.56 ; c.5 = 0.74 
     s.5 = 0.68 ; c.6 = 0.61 ; s.6 = 0.79 ; c.7 = 0.49 ; s.7 = 0.87 
     c.8 = 0.36 ; s.8 = 0.93 ; c.9 = 0.22 ; s.9 = 0.97
     return
    
    Cross:
     call Ln(arg(1),arg(2)-2,arg(1),arg(2)+2,3)
     call Ln(arg(1)-4,arg(2),arg(1)+4,arg(2))
     return
     
    Ad: call AreaDraw(HO,arg(1),arg(2)) ; return
    Fl:
     x = arg(1) ; y = arg(2) ; call WhichOg()
     if found then do ; call APen(pen) ; call Flood(HO,1,x,y) ; end
     return
    
    Flo: if arg() = 3 then call APen(arg(3))
     call Flood(HO,1,arg(1),arg(2))
     return
    
    DrawLine:
     parse var rest x y  ; lines = (x<621) ; dots = (~lines)
     double = (y<slot.2+5)
     if lines then call AddGadget(HO,602,slot.3,2,"Undo",'%l %d %x %y')
     call BPen(3) ; call pat(604,slot.2+7,'STOP') ; call BPen(0)   
     do forever
      call waitpkt(PORT) ; p = getpkt(PORT)
      if ~(p==NULL()) then do
       this = getarg(p) ; t =  reply(p,0)
       parse var this class c x y 
       if this = "CLOSEWINDOW" then signal 'Finish'
       if class = 'GADGETUP' then
        if c = 2 & lines then call Erase() ; else if c = 1 then leave 
        button_down = (c = 104) 
        
       if button_down then do 
        call WhichOg() ; if n > ogno then iterate
        x1 = x ; y1 = y ; button_up = 0 
        do until button_up
         call RHost("%l %c %x %y") ; parse var rharg class c x2 y2
         if class = 0 then do ; y2 = x2 ; x2 = c ; end
         if lines then do
          call SetDrMd(HO,JAM2) ; call Showem(x2,y2)
          call SetDrMd(HO,COMPLEMENT) ; end
         call Ln(x1,y1,x2,y2) ; call Ln(x1,y1,x2,y2)
         if double then call Dubb(2) 
         if dots then do 
           if double then call Dubb(1)
           x1 = x2 ; y1 = y2 ; end    
         button_up = (c = 232) 
         end
         call SetDrMd(HO,"JAM2") ; call Ln(x1,y1,x2,y2)
         if double then call Dubb(1)
        end
      end
      end
      call BPen(0) ; call pat(604,slot.2+7,'    ')
      if lines then call RemoveGadget(HO,2) 
      call ClearSlot(0,1,3)
      call Ln(620,slot.2,620,slot.3-3,3) ; call APen(1)
     return

    Dubb:
     dx1 = right-(x1-left) ; dx2 = right-(x2-left)
     call Ln(dx1,y1,dx2,y2) 
     if arg(1) = 2 then call Ln(dx1,y1,dx2,y2) 
     return
 
    Fill:
     do i = 0 to 7                                 /* Colour samples */
      s1 = 600+i*10-40*(i>3) ; s2 = s1 + 9 ; r = 5 + (i>3)
      call FRect(s1,slot.r-1,s2,slot.r+10,i)
     end
     call BPen(3)
     call pat(604,slot.4+7,'STOP',1) ; call BPen(0) ; pen = 3  
     do forever
       call waitpkt(PORT) ; p = getpkt(PORT)
       if ~(p==NULL()) then do
        this = getarg(p) ; t =  reply(p,0)
        parse var this class c x y 
        if class = "GADGETUP" & c = 3 then leave
    /* Choice of flood colour  */
        if x>600 & y>slot.5 & y < slot.7 then do
         row = (((y-slot.5)%12)) ; col = ((x-600)%10)
         pen = row * 4  + col ; call FRect(600,1,640,10,pen)
         call APen(pen) ;  iterate 
        end
        else call Fl(x,y) 
       end
      end
      call BPen(0) ; call pat(604,slot.4+7,'    ') 
      call ClearSlot(0,4,5,6)
     return
     
    Area :
     if dithers = 0 then do
      call FRect(5,Wh-12,632,Wh,2)
      a = 'Hang on. We do this only once per screen.' 
      call pat(100,Wh-16,a) ; dithers = 1
      do i = 0 to 1
       do j = 0 to 62 ; x = 4+j*10 ; y = Wh-12 + i*6
        call Move(HO,x,y) ; call Ad(x+9,y) 
        call Ad(x+9,y+5) ; call Ad(x,y+5) 
        call Ad(x,y) ; call AreaEnd(HO,512 + i*62 + j)
        end
       end
      call pat(100,Wh-16,copies(' ',length(a)))
      end
      call BPen(3) ; call pat(604,slot.7+7,'STOP') ; call BPen(0) ; pen = 3  
      do forever
       call waitpkt(PORT) ; p = getpkt(PORT)
       if ~(p==NULL()) then do
        this = getarg(p) ; t =  reply(p,0)
        parse var this class c x y 
        if class = "GADGETUP" & c = 4 then leave
        if  y>Wh-12 then do             /* Set pen */
         r = (y-(Wh-12))%6 ; co = (x-4)%10 ; areapen = 512 + r*62 + co
         g = slot.8 - 1
         call Move(HO,602,g) ;call Ad(638,g)
         call Ad(638,g+10) ; call Ad(602,g+10)
         call Ad(602,g) ; call AreaEnd(HO,areapen)
         end
         else call AreaClicks()
        end
        end
      call ClearSlot(8) ; call BPen(0) ; call pat(604,slot.7+7,'    ')
      call RefreshGadgets(HO)
     return
    
    AreaClicks:
     count = 0
     do forever
      call waitpkt(PORT) ; p = getpkt(PORT)
      if ~(p==NULL()) then do
       this = getarg(p) ; t =  reply(p,0)
       parse var this class c x y 
       if class = 'VANILLAKEY' then do 
        if count > 2 then call AreaEnd(HO,areapen) 
        return ; end
       if class = 'MOUSEBUTTONS' & c = 232 & y < (Wh-12) then do
             count = count +1 ; call Ad(x,y) ; end
       end
      end
     return
     
     RHost:
      call ReadHost(HO,PORT,arg(1))
      call waitpkt(PORT) ;  p = getpkt(PORT)
      if p ~==NULL() then do ; rharg = getarg(p) ; t = reply(p,0) ; end
      return rharg
    
     Erase: call APen(2) ; call Ln(x1,y1,x2,y2) 
      if double then call Ln(dx1,y1,dx2,y2)
      call APen(1) ; return
   
     WhichOg:
      found = 0                   /* Which ogive? */
      do n = 1 until found 
       if n > ogno then leave
       found = (x>left.n & x<right.n & y>top.n & y<hite.n) 
       end
      return

    OgiveRect:
     call waitpkt(PORT) ; p = getpkt(PORT)
     if ~(p==NULL()) then do
      this = getarg(p) ; t =  reply(p,0)
      parse var this class c x y 
       button_down = (c = 104) 
      
      if button_down then do 
       x1 = x ; y1 = y ;  button_up = 0 
       do until button_up
        call RHost("%l %c %x %y") ; parse var rharg class c x2 y2
        if class = 0 then do ; y2 = x2 ; x2 = c ; end
         call SetDrMd(HO,JAM2) ; call Showem(x2,y2)
         call SetDrMd(HO,COMPLEMENT) 
        call Box(x1,y1,x2,y2) ; call Box(x1,y1,x2,y2) 
        button_up = (c = 232) 
        end                      /* of until button_up */
        call SetDrMd(HO,"JAM2")
        /* Set limits for new ogive */
        ogno = ogno + 1
        left.ogno = x1;top.ogno=y1;right.ogno=x2;hite.ogno=y2
        call Ogive(x1 + (x2-x1)%2,x2-x1,y1,y2-y1) 
       end       /* of if button_down then do */
     end         /* of if (p.etc. then do     */
    return
    Box:
     call Ln(x1,y1,x2,y1) ;  call Draw(HO,x2,y2)
     call Draw(HO,x1,y2) ; call Draw(HO,x1,y1)
     return

    SetPointer:
     shape = 'sys:prefs/presets/' || arg(1) || '.pre'    
     if exists(shape) & exists('sys:prefs/pointer') then do
      com = 'sys:prefs/pointer' shape 'use'
      address command com
      end
     return
    
    SaveIt:
     ps = 'Picsaver' ; if exists(ps) then address command ps
     else do
       res = GetFile(150,50,,ps,'Where is ' || ps || '?')
       if res ~= '' then address command res
       end
     return
    
    Sample:
     x = 85 ; x1 = x
     do y = 100 to 170 by 5 ; x1 = x1 + 5 ; call Ln(x,y,x1,166) ; end
     x=156 ; x1 = x
     do y = 170 to 100 by -5 ; call Ln(x,y,x1,100) ; x1 = x1 - 5 ; end
     do x = 86 to 154 by 34 ; call Ln(120,74,x,100) ; end
     call Ln(89,118,146,165) ; call Ln(98,101,153,146)
     call Move(HO,87,101) ; call Ad(97,101) 
     call Ad(152,146) ; call Ad(152,166)
     call Ad(149,166) ; call Ad(87,115)
     call Ad(87,101) ; call AreaEnd(HO,512+80)
     call Flo(100,87,3) ; call Flo(140,87,4) ; call Flo(110,90,5)
     call Flo(130,90,6) ; call Flo(117,150,7) ; call Flo(128,117)
     call Flo(92,158,4) ; call Flo(92,163) ; call Flo(97,163)
     s = "MegaDisc" ; call BPen(2) ; call APen(1)
     do i = 1 to 8 ; call pat(82+8*i,104+7*i,substr(s,i,1)) ; end 
     call BPen(0)
    return    
    
    Hamilton, New Zealand  June, 1994
    
                     ------------------------