home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 4 / CDPD_IV.bin / fish / 911-930 / ff916 / wbrain / wbrain.e < prev    next >
Text File  |  1994-05-04  |  20KB  |  554 lines
  1. /***************************************************************************
  2. ***                           WBrain v1.0
  3. ***
  4. ***   Brain for the WorkBench.  Based on Brain by Andre Wichmann.
  5. ***   WBrain takes no code from Brain, and is written entirely in Amiga_E.
  6. ***
  7. ***   Amiga_E is a programming language by Wouter van Oortmerssen which
  8. ***   produces very small, fast code, and is designed to simplify the
  9. ***   creation of user interfaces.
  10. ***   
  11. ***   Brain v1.01 can be obtained from the Fred Fish PD disk #652.
  12. ***   I'm not exactly sure where I obtained Amiga_E, but you can contact
  13. ***   Wouter by mail:
  14. ***      Wouter van Oortmerssen
  15. ***      Levendaal 87
  16. ***      2311 JG leiden
  17. ***      HOLLAND
  18. ***   or by EMail:
  19. ***      Wouter@alf.let.uva.nl
  20. ***      Wouter@mars.let.uva.nl
  21. ***      Oortmers@gene.fwi.uva.nl
  22. ***   
  23. ***   You can contact me only through snailmail:
  24. ***      Sean Russell
  25. ***      Claude-Lorrain-Str 31
  26. ***      81543 München
  27. ***      GERMANY
  28. ***
  29. ***   If you want to change this code, I suggest the first thing you
  30. ***   start with is the variable names.  I tend to make local variable
  31. ***   names rather short and ambiguous, since my routines are usually
  32. ***   pretty short and it's not that hard to remember what the variables
  33. ***   stand for (for me).
  34. ***/
  35.  
  36. /***************************************************************************
  37. ***                 Global Setup
  38. ***/
  39. OPT OSVERSION=37        /*  Only runs on WB2.x or greater */
  40.  
  41. ENUM NONE,ER_LIB,ER_WB,ER_VISUAL,ER_MENUS,ER_WIND,ER_CONTEXT,
  42.       ER_GADGET,ER_REQTOOLS            /* Error codes */
  43. ENUM G_SLIDER, G_UNDO, G_RETRY, G_NEW    /* Gadget codes */
  44.  
  45. MODULE 'intuition/intuition', 'intuition/screens', 'gadtools',
  46.          'libraries/gadtools', 'intuition/gadgetclass', 'exec/nodes',
  47.          'ReqTools', 'libraries/reqtools'
  48.    
  49. CONST BASE=$F800,                /* What all menu messages have in common     */
  50.       MENU1=$0, MENU2=$1, MENU3=$2, /* For menus 1 - 3                        */
  51.       ITEM1=$0, ITEM2=$20, ITEM3=$40, ITEM4=$60, ITEM5=$80  /* For items 1-5  */
  52.       
  53. CONST M_ABOUT=BASE OR MENU1 OR ITEM1,  /* Here we set the values for the      */
  54.       M_QUIT=BASE OR MENU1 OR ITEM2,   /* various menu items to the values    */
  55.                                        /* that are returned by Intuition.     */
  56.       M_UNDO=BASE OR MENU2 OR ITEM1,   /* Perhaps they are defined somewhere, */
  57.       M_RETRY=BASE OR MENU2 OR ITEM2,  /* but I found them out by trial and   */
  58.       M_NEW=BASE OR MENU2 OR ITEM3     /* error.                              */
  59.  
  60. CONST MAX=10, MIN=2                 /* Used for maximum and minimum           */
  61. CONST DMAX=MAX*MAX                  /* In-between value; not used, but we     */
  62.                                     /* can't define complex CONSTants         */
  63. CONST MAXUNDOS=DMAX+1               /* rows*columns+1; the max number of moves*/
  64.  
  65. OBJECT gy               /* I didn't find a way to do multi-dimensional arrays */
  66.    y[MAX]:ARRAY         /* in E, so we have to do some gymnastics if we want  */
  67. ENDOBJECT               /* to simulate them.  This would be an *excellent*    */
  68.                         /* thing to change if you know a better way to do it. */
  69.  
  70. DEF w=NIL : PTR TO window,       /* We set these values initially to NIL*/
  71.     visual=NIL,                  /* so that if they don't get set we can*/
  72.     scr=NIL:PTR TO screen,       /* capture the errors.                 */
  73.     menu, glist=NIL,g,           /* For the gadgets.                    */
  74.     gx[MAX]:ARRAY OF gy,    /* The grid.  Like I said, I couldn't find
  75.                   a way to use multi-dimensional arrays normally.
  76.                   Yes, I've tried the standard x[n][n] and x[n,n]       */
  77.     goalx[MAX]:ARRAY OF gy,         /* The goal array                   */
  78.     moves[MAXUNDOS]:ARRAY OF CHAR,  /* For the UNDO function            */
  79.     rows=8, columns=8,              /* start values for rows and columns.
  80.                   Oh, I should point out that I defined these somewhat
  81.                   dyslexicly; rows are actually the columns, and columns,
  82.                   rows.  Since I was consistant in my stupidity, it works.    */
  83.     offx, offy, wflags, rflags,  /* window offsets for x&y; someday I'll change
  84.                   the window to a GIMMEZEROZERO and won't need these, but since
  85.                   that's more a matter of programming conveniency (as opposed
  86.                   to preformance), I'm not in a big hurry to do it.           */
  87.     wx, wy, move=0,  /* Row width and column height (after the buttons and borders)*/
  88.     basex, basey, level     /* Minimum width and height; game level         */
  89.  
  90. /******************************************************************************
  91. ***                         PROC main
  92. ***/    
  93. PROC main()
  94.    Rnd(100)       /* Version 1.1 will use the date/time to get a really random
  95.                      starting grid */
  96.    wflags := IDCMP_CLOSEWINDOW OR IDCMP_MENUPICK OR IDCMP_REFRESHWINDOW OR
  97.                IDCMP_MOUSEBUTTONS OR IDCMP_GADGETUP OR IDCMP_NEWSIZE
  98.    rflags := WFLG_DRAGBAR OR WFLG_ACTIVATE OR WFLG_DEPTHGADGET OR
  99.              WFLG_CLOSEGADGET OR WFLG_SMART_REFRESH OR WFLG_SIZEGADGET
  100.  
  101.    checkerr(openlibs())
  102.    cleargrid(1)
  103.    cleargrid(2)
  104.    drawgrid()
  105.    new()          /* New goal */
  106.    move := 0      /* Number of moves by player=0 */
  107.    text()
  108.    WHILE (parse(Gt_GetIMsg(w.userport)))<>IDCMP_CLOSEWINDOW
  109.       IF CtrlC()
  110.          closeall()
  111.          CleanUp(0)
  112.       ENDIF
  113.       WaitTOF()   /* This is for multitasking friendlyness  */
  114.    ENDWHILE
  115.    closeall()
  116.    CleanUp(0)
  117. ENDPROC
  118.  
  119. /******************************************************************************
  120. ***                     PROC text
  121. ***
  122. ***   Puts the Row: Col: text in the window
  123. ***/
  124. PROC text()
  125.    DEF i
  126.    FOR i:=0 TO 2  /* Draw beveled box.  Could be replaced with Reqtools func. */
  127.       Line(offx+3,basey+(i*15),offx+72, basey+(i*15),1)
  128.       Line(offx+3,basey+(i*15),offx+3, basey+12+(i*15),1)
  129.       Line(offx+4,basey+(i*15),offx+4, basey+11+(i*15),1)
  130.       Line(offx+72,basey+(i*15),offx+72, basey+12+(i*15),2)
  131.       Line(offx+71,basey+(i*15)+1,offx+71,basey+13+(i*15),2)
  132.       Line(offx+4,basey+12+(i*15),offx+72, basey+12+(i*15),2)
  133.    ENDFOR
  134.    Colour(1,0)
  135.    TextF(offx+6,basey+9, 'Colms:\d[2]',rows)
  136.    TextF(offx+6,basey+24,'Rows :\d[2]',columns)
  137.    TextF(offx+6,basey+39,'Level:\d[2]',level)
  138. ENDPROC
  139.  
  140. /******************************************************************************
  141. ***                     PROC parse
  142. ***
  143. ***   Evaluates the intuition message
  144. ***
  145. ***/
  146. PROC parse(msg:PTR TO intuimessage)
  147.    DEF myclass
  148.    
  149.    myclass := msg.class
  150.    SELECT myclass
  151.       CASE IDCMP_MENUPICK
  152.          domenu(msg)
  153.       CASE IDCMP_CLOSEWINDOW
  154.          RETURN myclass
  155.       CASE IDCMP_GADGETUP
  156.          dogadgets(msg)
  157.       CASE IDCMP_NEWSIZE
  158.          resize()
  159.       CASE IDCMP_REFRESHWINDOW
  160.          Gt_BeginRefresh(w)
  161.          Gt_EndRefresh(w,TRUE)
  162.       CASE IDCMP_MOUSEBUTTONS
  163.          IF dobuttons(msg)=1 THEN RtEZRequestA('You\ave won the game!!!','Ok',0,0,0)
  164.    ENDSELECT
  165.    Gt_ReplyIMsg(msg)            /* Again, I don't know why.  I saw it      */
  166. ENDPROC                         /* in GadToolsDemo, and it couldn't hurt.  */
  167.  
  168. /******************************************************************************
  169. ***                         PROC domenu
  170. ***
  171. ***   Evaluates the intuition message for menupicks
  172. ***
  173. ***/
  174. PROC domenu(msg:PTR TO intuimessage)
  175.    DEF mycode
  176.    
  177.    mycode := msg.code
  178.    SELECT mycode
  179.       CASE M_ABOUT
  180.          RtEZRequestA('WBrain v0.0\nBy Sean Russell\n\nWritten in Amiga_E\nBased on Brain by Andre Wichmann\n©1993 All rites preserved','Ok',0,0,0)
  181.        CASE M_UNDO
  182.          undo()
  183.        CASE M_RETRY
  184.          cleargrid(1)      /* Clear player grid, and                    */
  185.          move := 0         /* set the number of moves back to 0         */
  186.        CASE M_NEW
  187.          new()
  188.        CASE M_QUIT
  189.          closeall()
  190.          CleanUp(0)
  191.    ENDSELECT
  192. ENDPROC
  193.  
  194. /******************************************************************************
  195. ***                      PROC dogadgets
  196. ***
  197. ***   Evaluates the intuition message for gadget presses
  198. ***
  199. ***/
  200. PROC dogadgets(msg:PTR TO intuimessage)
  201.    DEF mygad,gad:PTR TO gadget
  202.    
  203.    gad:=msg.iaddress
  204.    mygad := gad.gadgetid
  205.    SELECT mygad
  206.       CASE G_UNDO
  207.          undo()
  208.       CASE G_RETRY
  209.          cleargrid(1)
  210.          move := 0
  211.       CASE G_NEW
  212.          new()
  213.       CASE G_SLIDER
  214.          level := msg.code
  215.          text()
  216.          new()
  217.    ENDSELECT
  218. ENDPROC
  219.  
  220. /*******************************************************************************
  221. ***                      PROC dobuttons
  222. ***
  223. ***   The actual game routine.  Checks if the button click was of the right
  224. ***   type (buttondown AND leftbutton = $68), checks if the click was in the
  225. ***   right range (within the grid on the right side of the window), calculates
  226. ***   in which box the click was made, calls "put", calls to see if the game
  227. ***   was won with this move, and sets up the undo array.
  228. ***/
  229. PROC dobuttons(msg:PTR TO intuimessage)
  230.    DEF x,y,t,win
  231.    
  232.    x:= msg.mousex
  233.    y:= msg.mousey
  234.    IF (msg.code = $68) AND (x >= (wx+5)) AND (x <= ((rows*20)+(wx+5))) AND
  235.       (y >= 16) AND (y <= ((columns*20)+16))
  236.       x := (x-(wx+5))/20
  237.       y := (y-16)/20
  238.       t:=gx[x].y
  239.       IF t[y] = 0
  240.          put(1,x,y,1)
  241.          win := checkwin()
  242.          move++
  243.          moves[move] := (x*10)+y
  244.       ENDIF
  245.    ENDIF
  246. ENDPROC win
  247.  
  248. /****************************************************************************
  249. ***                            PROC undo
  250. *** 
  251. ***   Takes back one move.
  252. ***
  253. ***/
  254. PROC undo()
  255.    DEF x,y
  256.  
  257.    x := moves[move] /10
  258.    y := Mod(moves[move],10)
  259.    IF move <> 0
  260.       put(1,x,y,-1)
  261.       moves[move] := 0
  262.       move--
  263.    ENDIF
  264. ENDPROC
  265.  
  266. /*******************************************************************************
  267. ***                            PROC checkwin
  268. ***
  269. ***   Checks to see if the game is won (by comparing the left grid, goalx, with
  270. ***   the right grid, gx)
  271. ***/
  272. PROC checkwin()
  273.    DEF i,j,win=1,t,u
  274.    
  275.    FOR i := 0 TO (rows-1)
  276.       t := gx[i].y
  277.       u := goalx[i].y
  278.       FOR j := 0 TO (columns-1)
  279.          IF t[j] <> u[j] THEN win:=0
  280.       ENDFOR
  281.    ENDFOR
  282. ENDPROC win
  283.  
  284. /********************************************************************************
  285. ***                     PROC openlibs
  286. ***
  287. ***   Opens the libraries and sets up the window with gadgets and menus.
  288. ***/
  289. PROC openlibs()
  290.    DEF offs:PTR TO LONG, names:PTR TO LONG, i
  291.  
  292.    IF (reqtoolsbase:=OpenLibrary('reqtools.library',37))=NIL THEN RETURN ER_REQTOOLS
  293.    IF (gadtoolsbase := OpenLibrary('gadtools.library', 37))=NIL THEN RETURN ER_LIB
  294.    IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN ER_WB
  295.    IF (visual:=GetVisualInfoA(scr, NIL))=NIL THEN RETURN ER_VISUAL
  296.    IF (menu:=CreateMenusA([1,0,'Project',0,0,0,0,
  297.                            2,0,'About',0,0,0,0,
  298.                            2,0,'Quit','q',0,0,0,
  299.                            1,0,'Game',0,0,0,0,
  300.                            2,0,'Undo','u',0,0,0,
  301.                            2,0,'Retry','a',0,0,0,
  302.                            2,0,'New','n',0,0,0,
  303.                            0,0,0,0,0,0,0]:newmenu, NIL))=NIL THEN RETURN ER_MENUS
  304.    IF LayoutMenusA(menu,visual,NIL)=FALSE THEN RETURN ER_MENUS
  305.    offx := scr.wborleft + 3
  306.    offy := scr.wbortop + 3
  307.    basex := (MIN*20)+85+scr.wborleft
  308.    basey := 78+scr.wbortop
  309.    wx := (rows*20)+85+scr.wborleft
  310.    wy := (columns*20)+15
  311.    IF wx < basex THEN wx := basex
  312.    IF wy < basey THEN wy := basey
  313.    IF (g:=CreateContext({glist}))=NIL THEN RETURN ER_CONTEXT
  314.    IF (g:=CreateGadgetA(SCROLLER_KIND,g,
  315.       [offx,offy+120,75,10,NIL,NIL,0,0,visual,0]:newgadget,
  316.       [GTSL_MIN,1,GTSL_MAX,5,GTSL_LEVEL,5,/*GTSL_MAXLEVELLEN,5,*/GA_RELVERIFY,TRUE,
  317.        GA_IMMEDIATE,TRUE,GTSC_TOP,0,GTSC_VISIBLE,2,GTSC_TOTAL,5,PGA_FREEDOM,
  318.        LORIENT_HORIZ,0]))=NIL THEN RETURN ER_GADGET
  319.    offs := [12,32,52]
  320.    names := ['Undo','Retry','New']
  321.    FOR i := 0 TO 2
  322.       IF (g:=CreateGadgetA(BUTTON_KIND,g,
  323.          [offx,offy+offs[i],75,20,names[i], PLACETEXT_IN,
  324.          i+1,0,visual,0]:newgadget,NIL))=NIL THEN RETURN ER_GADGET
  325.    ENDFOR
  326.    IF (w:= OpenW(20, 11, ((wx*2)-82)+offx+scr.wborright+10, wy+offy+2, wflags, rflags, 'WBrain v1.0', NIL, 1, glist)) = NIL THEN RETURN ER_WIND
  327.    w.minwidth := ((basex*2)-65)+scr.wborright
  328.    w.minheight := offy+135
  329.    w.maxwidth := (MAX*40)+110+scr.wborleft+scr.wborright
  330.    w.maxheight := (MAX*20)+20
  331.    IF SetMenuStrip(w, menu)=FALSE THEN RETURN ER_MENUS
  332.    Gt_RefreshWindow(w, NIL)
  333.    SetTopaz(8)       /* Maybe someday I'll make the program font-sensitive... */
  334.    Colour(1,0)       /* Text color                                            */
  335. ENDPROC
  336.  
  337. /**************************************************************************
  338. ***                         PROC closeall
  339. ***
  340. ***   Closes down everything that is open.
  341. ***/
  342. PROC closeall()
  343.    IF w THEN ClearMenuStrip(w)
  344.    IF menu THEN FreeMenus(menu)
  345.    IF visual THEN FreeVisualInfo(visual)
  346.    IF w THEN CloseW(w)
  347.    IF glist THEN FreeGadgets(glist)
  348.    IF scr THEN UnlockPubScreen(NIL, scr)
  349.    IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  350.    IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  351. ENDPROC
  352.  
  353. /*******************************************************************************
  354. ***                         PROC checkerr
  355. ***
  356. ***   If an error is found during one of the many opening routines (for gadgets,
  357. ***   windows, libraries, etc.), checkerr gets the return code and displays the
  358. ***   error.
  359. **/
  360. PROC checkerr(err)
  361.    DEF errors:PTR TO LONG
  362.    IF err > 0
  363.       closeall()
  364.       errors:=['', 'open gadtools.library v37', 'lock Workbench',
  365.                'get visual info', 'create menus', 'open window',
  366.                'create context', 'create gadgets', 'open ReqTools']
  367.       WriteF('Couldn\at \s!\n', errors[err])
  368.       CleanUp(10)
  369.    ENDIF
  370. ENDPROC TRUE
  371.  
  372. /************************************************************************
  373. ***                     PROC resize
  374. ***
  375. ***   Gets a new usersize for the grid.
  376. ***/
  377. PROC resize()
  378.    DEF buttons,y1
  379.  
  380.    buttons:=offx+80; y1:=offy+10
  381.    rows := ((w.width-buttons)-(w.borderright+4)-5)/40
  382.    columns := (w.height-(y1+4))/20
  383.    wx := (rows*20)+85+scr.wborleft
  384.    wy := (columns*20)+15
  385.    IF wx < basex THEN wx := basex
  386.    IF wy < basey THEN wy := basey
  387.    Box(buttons,y1,w.width-(w.borderright+1),w.height-(w.borderbottom+1),0)
  388.    text()
  389.    cleargrid(1)         /* empty the two grids                          */
  390.    cleargrid(2)
  391.    drawgrid()           /* draw the grids                               */
  392.    new()                /* New goal                                     */
  393. ENDPROC
  394.  
  395. /*************************************************************************
  396. ***                     PROC cleargrid
  397. ***
  398. ***   fills the grid with 0s and clears the display grid by calling "put"
  399. ***   with value 0.
  400. ***/
  401. PROC cleargrid(n)
  402.    DEF i,j,t
  403.    
  404.    FOR i := 0 TO (rows-1)
  405.       IF n = 1 THEN t := gx[i].y ELSE t:=goalx[i].y
  406.       FOR j := 0 TO (columns-1)
  407.          t[j] := 0
  408.          box(n,i,j,0)
  409.       ENDFOR 
  410.    ENDFOR
  411. ENDPROC
  412.   
  413. /***************************************************************************
  414. ***                  PROC drawgrid
  415. ***
  416. ***   Draws both grids in the window
  417. ***/
  418. PROC drawgrid()
  419.    DEF i,j,x1,y,x2
  420.    
  421.    FOR i:= 0 TO rows-1
  422.       FOR j := 0 TO columns -1
  423.          x1 := (i*20)+offx + 80 ; x2 := x1+wx-80
  424.          y := (j*20)+offy+10 
  425.          Line( x1,y, x1+18,y, 2); Line( x2,y, x2+18,y, 2)
  426.          Line( x1,y, x1,y+18, 2); Line( x2,y, x2,y+18, 2)
  427.          Line( x1+18,y, x1+18,y+18, 1); Line( x2+18,y, x2+18,y+18, 1)
  428.          Line( x1,y+18, x1+18,y+18, 1); Line( x2,y+18, x2+18,y+18, 1)
  429.       ENDFOR
  430.    ENDFOR
  431. ENDPROC
  432.  
  433. /****************************************************************************
  434. ***                     PROC new
  435. ***
  436. ***   New does a lot of work; it clears the two grids and fills the goal
  437. ***   grid with a new pattern by randomly choosing empty boxes in the goal
  438. ***   grid until it is full.  It calls "put" and therefore generates a grid
  439. ***   of a random pattern which is solvable by the player.
  440. ***/
  441. PROC new()
  442.    DEF rnd1,rnd2,i,j,k,x,y,
  443.     list[MAXUNDOS]:ARRAY OF CHAR
  444.    
  445.    cleargrid(1)
  446.    cleargrid(2)
  447.    move :=0
  448.    FOR i := 0 TO (MAX-1)               /* fill an array with all of the    */
  449.       FOR j := 0 TO (MAX-1)            /* boxes. The coordinates are stored*/
  450.          list[(i*10)+j] := (i*10)+j    /* as complex numbers; (1,1)=11,    */
  451.       ENDFOR                           /* (2,1)=22, etc.                   */
  452.    ENDFOR
  453.    FOR i := 0 TO (MAXUNDOS-2)          /* Go through MAXUNDOS times and    */
  454.       rnd1 := Rnd(MAXUNDOS-2)          /* swap two random elements each    */
  455.       rnd2 := Rnd(MAXUNDOS-2)          /* time.  This gives us our random  */
  456.       j := list[rnd1]                  /* selection.                       */
  457.       list[rnd1] := list[rnd2]
  458.       list[rnd2] := j
  459.    ENDFOR
  460.    k:=0
  461.    FOR i := 1 TO rows                  /* Now we put the boxes in this     */
  462.       FOR j := 1 TO columns            /* random order we've set up.  We   */
  463.          x := list[k]/10               /* have to make sure that each is a */
  464.          y := Mod(list[k],10)          /* valid box value for the number of*/
  465.          k := k+1                      /* rows and columns we have.        */
  466.          WHILE ((x>(rows-1)) OR (y>(columns-1))) AND (k < (MAXUNDOS-1))
  467.             x := list[k]/10            /* If it's not valid, we have to    */
  468.             y := Mod(list[k],10)       /* step through the list until we   */
  469.             k := k+1                   /* find one that is.                */
  470.          ENDWHILE
  471.          put(2,x,y,1)
  472.       ENDFOR
  473.    ENDFOR
  474. ENDPROC
  475.  
  476. /****************************************************************************
  477. ***                     PROC put
  478. ***
  479. ***   Puts a box.  n is the grid number (1=gx, 2=goalx), x and y are, of
  480. ***   course, the box coordinates, and "as" is either 1 or -1.  If as is -1,
  481. ***   then we're undoing boxes; that is, we're taking a box out of the grid,
  482. ***   rather than putting one in.
  483. ***   The levels are handled here:
  484. ***   level 0: Normal play (add to the four primary neighbors)
  485. ***   level 1: Add to all 8 neighbors
  486. ***   level 2: Add to primary neighbors and primary neighbors 2 away
  487. ***   level 3: Add to all 8 neighbors and all neigbors 2 away
  488. ***/
  489. PROC put(n,x,y,as)
  490.    DEF i, j, target,start=-1, end=1
  491.    
  492.    IF level>1
  493.       start:=-2; end:=2
  494.    ENDIF
  495.    FOR i := start TO end
  496.       FOR j := start TO end
  497.          IF ((i=0) OR (j=0)) OR ((level=1) OR (level=3))
  498.             target := IF ((i=0) AND (j=0)) THEN 1 ELSE 0
  499.             putsub(n,x+i,y+j,as,target)
  500.          ENDIF
  501.       ENDFOR
  502.    ENDFOR
  503. ENDPROC
  504.  
  505. /***********************************************************************
  506. ***                     PROC putsub
  507. ***
  508. ***   Just an extension routine for put.
  509. ***   This adds one to x,y if grid[x][y] = 0 AND target = TRUE or if
  510. ***   grid[x][y]<>0 AND target = FALSE.
  511. **/
  512. PROC putsub(n,x,y,as,target)
  513.    DEF t
  514.  
  515.    IF ((x<rows) AND (x>=0) AND (y<columns) AND (y>=0))
  516.       IF n=1 THEN t:=gx[x].y ELSE t:=goalx[x].y
  517.       IF t[y]=0
  518.          IF target=1
  519.             t[y]:=1
  520.             box(n,x,y,t[y])
  521.          ENDIF
  522.       ELSE
  523.          t[y] := t[y] + as
  524.          IF t[y] = 5
  525.             t[y] := 1
  526.          ELSEIF t[y]=0
  527.             t[y]:=IF target=1 THEN 0 ELSE 4
  528.          ENDIF
  529.          box(n,x,y,t[y])
  530.       ENDIF
  531.    ENDIF
  532. ENDPROC
  533.  
  534. /***********************************************************************
  535. ***                     PROC box
  536. ***
  537. ***   Draws a colored box in a specified grid coordinate.  n is the grid
  538. ***   number (1=right grid, 2=left grid), x and y are the coordinates, 
  539. ***   and v is the number to draw.  If v is (1-4), then box will also put
  540. ***   the number in the box.  If v is 0, then it simply clears the box.
  541. ***/
  542. PROC box(n,x,y,v)
  543.    DEF x1,y1,colors:PTR TO LONG
  544.    
  545.    colors := [0,3,4,5,6]
  546.    x1 := (x*20)+offx + wx
  547.    IF n = 2 THEN x1 := x1-wx+80
  548.    y1 := (y*20)+offy+10
  549.    Box( x1+1,y1+1, x1+17,y1+17, colors[v])
  550.    Colour(1,colors[v])
  551.    IF v>0 THEN TextF(x1+5,y1+11,'\d[1]',v)
  552. ENDPROC
  553.  
  554.