1 -- LML original: Sandra Foubister, 1990
    2 -- Haskell translation: Colin Runciman, May 1991
    3 
    4 module Layout( setup,dpxyorig, dpxygap, dpxynum,invisibletext,
    5                vistextreg, designarea,tilearea,inpicarea,picarea,
    6                textarea, helptextarea, dpgrid,tpgrid,picgrid,
    7                cleara, picxorig, picyorig, picbox,menumark,unmenumark,
    8                tpxorig, tpyorig, tpxygap,inrect, incirc,
    9                todesign, tofiddle, totile, tohelp, indgrid, 
   10                inbigtile, indesign, indsave, indclear,
   11                indget, intsave, intclear, intget, intile4, 
   12                inhelp, inquit, intodraw, intotile, intoalter) where
   13 
   14 import Mgrfuns
   15 import Drawfuns
   16 import Diff
   17 
   18 -- dp definitions relate to the design phase of the program
   19 --CR so they are now obsolete - in name at least
   20 
   21 dpxyorig, dpxygap, dpxynum :: Int
   22 dpxyorig = 20
   23 dpxygap  = 20
   24 dpxynum  = 19
   25 
   26 dpfun :: Int -> Int -> [Char]
   27 dpfun    = drawdot
   28 
   29 dpgrid :: [Char]
   30 dpgrid = grid dpxyorig dpxyorig dpxygap dpxygap dpxynum dpxynum dpfun
   31 
   32 designarea :: [Int]
   33 designarea = [0,0,390,390]
   34 
   35 -- tp definitions relate to the tiling phase of the program
   36 --CR so they too are obsolete - in name at least
   37 
   38 tpxorig, tpyorig, tpxygap, tpxynum :: Int
   39 tpxorig = 524
   40 tpyorig = 20
   41 tpxygap = 72
   42 tpxynum = 9
   43 
   44 tpfun :: Int -> Int -> [Char]
   45 tpfun   = drawdot
   46 
   47 tpgrid :: [Char]
   48 tpgrid = grid tpxorig tpyorig tpxygap tpxygap tpxynum tpxynum tpfun
   49 
   50 tilearea :: [Int]
   51 tilearea = [521,18,580,580]
   52 
   53 -- tm definitions relate to the menu for the tiling phase
   54 
   55 tmxorig, tmyorig, tmxygap, tmxnum, tmynum :: Int
   56 tmxorig = 485
   57 tmyorig = 282
   58 tmxygap = 57
   59 tmxnum  = 1
   60 tmynum  = 6
   61 
   62 tmfun :: Int -> Int -> [Char]
   63 tmfun   = circ 28
   64 
   65 tmgrid :: [Char]
   66 tmgrid = grid tmxorig tmyorig tmxygap tmxygap tmxnum tmynum tmfun
   67 
   68 -- dm definitions relate to the menu for the design phase
   69 
   70 dmxorig, dmyorig, dmxygap, dmxnum, dmynum :: Int
   71 dmxorig = 425
   72 dmyorig = 54
   73 dmxygap = 57
   74 dmxnum  = 1
   75 dmynum  = 4
   76 
   77 dmfun :: Int -> Int -> [Char]
   78 dmfun   = circ 28
   79 
   80 dmgrid :: [Char]
   81 dmgrid = grid dmxorig dmyorig dmxygap dmxygap dmxnum dmynum dmfun
   82 
   83 -- pic definitions relate to the display of the eight orientations
   84 -- of the print
   85 
   86 picxorig, picyorig, picxygap, picxnum, picynum :: Int
   87 picxorig = 624
   88 picyorig = 676
   89 picxygap = 100
   90 picxnum  = 4
   91 picynum  = 2
   92 
   93 picfun :: Int -> Int -> [Char]
   94 picfun   = squ 74
   95 
   96 picgrid :: [Char]
   97 picgrid =
   98   grid (picxorig -1) (picyorig-1) picxygap picxygap picxnum picynum picfun
   99 
  100 inpicarea :: Int -> Int -> Bool
  101 inpicarea = inrect 624 676 400 200
  102 
  103 picarea :: [Int]
  104 picarea = [623,675,400,200]
  105 
  106 picbox :: Int -> [Int]
  107 picbox 1 = [picxorig,picyorig,72,72]
  108 picbox 2 = [picxorig + picxygap,picyorig,72,72]
  109 picbox 3 = [picxorig + (2 * picxygap),picyorig,72,72]
  110 picbox 4 = [picxorig + (3 * picxygap),picyorig,72,72]
  111 picbox 5 = [picxorig,picyorig + picxygap,72,72]
  112 picbox 6 = [picxorig + picxygap,picyorig + picxygap,72,72]
  113 picbox 7 = [picxorig + (2 * picxygap),picyorig + picxygap,72,72]
  114 picbox 8 = [picxorig + (3 * picxygap),picyorig + picxygap,72,72]
  115 
  116 textarea :: [Int]
  117 textarea = [50,550,300,300]
  118 
  119 -- vistextreg is the region into which to type filenames
  120 vistextreg :: [Char]
  121 vistextreg = textregion [50,615,200,100]
  122 
  123 helptextarea :: [Int]
  124 helptextarea = [50,500,380,400]
  125 
  126 -- cleartextreg incorporates vistextreg and the prompt region
  127 cleara :: [Int] -> [Char]
  128 cleara area = textregion area ++ clear ++ invisibletext
  129 
  130 -- these are strings to go in the menu boxes
  131 menustrings :: [Char]
  132 menustrings = func 4 ++
  133               font 8 ++
  134               stringto 0 405 64 "DRAW" ++
  135               stringto 0 405 121 "SAVE" ++
  136               stringto 0 410 178 "GET" ++
  137               stringto 0 402 235 "CLEAR" ++
  138               stringto 0 468 292 "TILE" ++
  139               stringto 0 462 349 "ALTER" ++
  140               stringto 0 468 404 "SAVE" ++
  141               stringto 0 471 463 "GET" ++
  142               stringto 0 464 520 "CLEAR" ++
  143               stringto 0 474 577 "T4" ++
  144               font 12 ++
  145               stringto 0 457 729 "HELP" ++
  146               stringto 0 457 829 "QUIT" ++
  147               font 13 ++
  148               stringto 0 112 450 "STAMP DESIGN"++
  149               stringto 0 730 666 "TILE DESIGN"++
  150               func 15
  151 
  152 -- invisibletext sets up a scrolling text region, then moves the
  153 -- text cursor out of it. 
  154 
  155 invisibletext :: [Char]
  156 invisibletext = vistextreg ++
  157                 go [500,500] ++
  158                 aligntext ++ "\n"
  159 
  160 
  161 inrect :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
  162 inrect x y w h xp yp = xp > x && xp <= x + w &&
  163                        yp > y && yp <= y + h
  164 
  165 dmcirc, tmcirc, amcirc, hmcirc :: [Char]
  166 dmcirc = circle [425,54,30]
  167 tmcirc = circle [485,282,30]
  168 amcirc = circle [485,339,30]
  169 hmcirc = circle [485,712,38] 
  170 
  171 modemark :: [Char] -> [Char]
  172 modemark str = 
  173         case str of
  174           "draw" -> dmcirc ++ undo (tmcirc ++ amcirc ++ hmcirc)
  175           "tile" -> tmcirc ++ undo (dmcirc ++ amcirc ++ hmcirc)
  176           "alter"-> amcirc ++ undo (dmcirc ++ tmcirc ++ hmcirc)
  177           "help" -> hmcirc ++ undo (dmcirc ++ tmcirc ++ amcirc)
  178 
  179 menumark :: [Char] -> [Char]
  180 menumark "tsave" = circ 30 tmxorig (tmyorig + (2 * tmxygap))
  181 menumark "tget"  = circ 30 tmxorig (tmyorig + (3 * tmxygap))
  182 menumark "tclear"= circ 30 tmxorig (tmyorig + (4 * tmxygap))
  183 menumark "t4"    = circ 30 tmxorig (tmyorig + (5 * tmxygap))
  184 menumark "dsave" = circ 30 dmxorig (dmyorig +  dmxygap)
  185 menumark "dget"  = circ 30 dmxorig (dmyorig + (2 * dmxygap))
  186 menumark "dclear"= circ 30 dmxorig (dmyorig + (3 * dmxygap))
  187 
  188 unmenumark :: [Char] -> [Char]
  189 unmenumark = undo . menumark
  190 
  191 incirc :: Int -> Int -> Int -> Int -> Int -> Bool
  192 incirc xc yc r xp yp = square (xp - xc) + square (yp - yc) <= square r
  193 
  194 indgrid :: [Int] -> Bool
  195 indgrid [x0,y0,x1,y1] = indesign x0 y0 && indesign x1 y1
  196 
  197 inbigtile, indesign :: Int -> Int -> Bool
  198 inbigtile = inrect tpxorig tpyorig tpwh tpwh
  199             where 
  200             tpwh = tpxygap * (tpxynum - 1)
  201 indesign = inrect 0 0 390 390
  202 
  203 intodraw, indsave, indget, indclear :: Int -> Int -> Bool
  204 -- some abstraction needed here!!!
  205 intodraw = incirc dmxorig dmyorig 28
  206 indsave = incirc dmxorig (dmyorig + dmxygap) 28
  207 indget = incirc dmxorig (dmyorig + (2 * dmxygap)) 28
  208 indclear = incirc dmxorig (dmyorig + (3 * dmxygap)) 28
  209 
  210 intotile, intoalter, intsave, intget, intclear, intile4 :: Int -> Int -> Bool
  211 intotile = incirc tmxorig tmyorig 28
  212 intoalter = incirc tmxorig (tmyorig + tmxygap) 28
  213 intsave = incirc tmxorig (tmyorig + (2 * tmxygap)) 28
  214 intget = incirc tmxorig (tmyorig + (3 * tmxygap)) 28
  215 intclear = incirc tmxorig (tmyorig + (4 * tmxygap)) 28
  216 intile4 = incirc tmxorig (tmyorig + (5 * tmxygap)) 28
  217 
  218 inhelp, inquit :: Int -> Int -> Bool
  219 inhelp = incirc 485 712 36
  220 inquit = incirc 485 812 36
  221 
  222 -- the mode buttons:
  223 buttons :: [Char]
  224 buttons = circle [485,712,36] ++ circle [485,812,36]
  225 
  226 setup :: [Char]
  227 setup = textregion [0,0,0,0] ++
  228         clear ++ 
  229         tpgrid ++
  230         dpgrid ++
  231         tmgrid ++
  232         dmgrid ++
  233         picgrid ++
  234         buttons ++
  235         invisibletext ++
  236         menustrings ++
  237         todesign
  238 
  239 -- cs shouldn't have an effect if all the coordinates are
  240 -- outside the design area
  241 todesign :: [Char]
  242 todesign = setevent 1 "msc %p\n" ++ setevent 2 "cs %l\n" ++ modemark "draw"
  243 
  244 -- in this mode 1 should be able to select orientations if clicked
  245 -- over one of them, perhaps incorporate this in msa
  246 totile :: [Char]
  247 totile = setevent 1 "msa %p\n" ++
  248          setevent 2 "put %p\n" ++ 
  249          tpgrid ++
  250          modemark "tile" 
  251 
  252 tofiddle :: [Char]
  253 tofiddle = setevent 1 "msb %p\n" ++ setevent 2 "rot %p\n" ++ modemark "alter"
  254 
  255 tohelp :: [Char]
  256 tohelp = setevent 1 "msd %p\n" ++ setevent 2 "msd %p\n" ++ modemark "help"
  257 
  258 
  259