/*************************************************************************** *** WBrain v1.0 *** *** Brain for the WorkBench. Based on Brain by Andre Wichmann. *** WBrain takes no code from Brain, and is written entirely in Amiga_E. *** *** Amiga_E is a programming language by Wouter van Oortmerssen which *** produces very small, fast code, and is designed to simplify the *** creation of user interfaces. *** *** Brain v1.01 can be obtained from the Fred Fish PD disk #652. *** I'm not exactly sure where I obtained Amiga_E, but you can contact *** Wouter by mail: *** Wouter van Oortmerssen *** Levendaal 87 *** 2311 JG leiden *** HOLLAND *** or by EMail: *** Wouter@alf.let.uva.nl *** Wouter@mars.let.uva.nl *** Oortmers@gene.fwi.uva.nl *** *** You can contact me only through snailmail: *** Sean Russell *** Claude-Lorrain-Str 31 *** 81543 München *** GERMANY *** *** If you want to change this code, I suggest the first thing you *** start with is the variable names. I tend to make local variable *** names rather short and ambiguous, since my routines are usually *** pretty short and it's not that hard to remember what the variables *** stand for (for me). ***/ /*************************************************************************** *** Global Setup ***/ OPT OSVERSION=37 /* Only runs on WB2.x or greater */ ENUM NONE,ER_LIB,ER_WB,ER_VISUAL,ER_MENUS,ER_WIND,ER_CONTEXT, ER_GADGET,ER_REQTOOLS /* Error codes */ ENUM G_SLIDER, G_UNDO, G_RETRY, G_NEW /* Gadget codes */ MODULE 'intuition/intuition', 'intuition/screens', 'gadtools', 'libraries/gadtools', 'intuition/gadgetclass', 'exec/nodes', 'ReqTools', 'libraries/reqtools' CONST BASE=$F800, /* What all menu messages have in common */ MENU1=$0, MENU2=$1, MENU3=$2, /* For menus 1 - 3 */ ITEM1=$0, ITEM2=$20, ITEM3=$40, ITEM4=$60, ITEM5=$80 /* For items 1-5 */ CONST M_ABOUT=BASE OR MENU1 OR ITEM1, /* Here we set the values for the */ M_QUIT=BASE OR MENU1 OR ITEM2, /* various menu items to the values */ /* that are returned by Intuition. */ M_UNDO=BASE OR MENU2 OR ITEM1, /* Perhaps they are defined somewhere, */ M_RETRY=BASE OR MENU2 OR ITEM2, /* but I found them out by trial and */ M_NEW=BASE OR MENU2 OR ITEM3 /* error. */ CONST MAX=10, MIN=2 /* Used for maximum and minimum */ CONST DMAX=MAX*MAX /* In-between value; not used, but we */ /* can't define complex CONSTants */ CONST MAXUNDOS=DMAX+1 /* rows*columns+1; the max number of moves*/ OBJECT gy /* I didn't find a way to do multi-dimensional arrays */ y[MAX]:ARRAY /* in E, so we have to do some gymnastics if we want */ ENDOBJECT /* to simulate them. This would be an *excellent* */ /* thing to change if you know a better way to do it. */ DEF w=NIL : PTR TO window, /* We set these values initially to NIL*/ visual=NIL, /* so that if they don't get set we can*/ scr=NIL:PTR TO screen, /* capture the errors. */ menu, glist=NIL,g, /* For the gadgets. */ gx[MAX]:ARRAY OF gy, /* The grid. Like I said, I couldn't find a way to use multi-dimensional arrays normally. Yes, I've tried the standard x[n][n] and x[n,n] */ goalx[MAX]:ARRAY OF gy, /* The goal array */ moves[MAXUNDOS]:ARRAY OF CHAR, /* For the UNDO function */ rows=8, columns=8, /* start values for rows and columns. Oh, I should point out that I defined these somewhat dyslexicly; rows are actually the columns, and columns, rows. Since I was consistant in my stupidity, it works. */ offx, offy, wflags, rflags, /* window offsets for x&y; someday I'll change the window to a GIMMEZEROZERO and won't need these, but since that's more a matter of programming conveniency (as opposed to preformance), I'm not in a big hurry to do it. */ wx, wy, move=0, /* Row width and column height (after the buttons and borders)*/ basex, basey, level /* Minimum width and height; game level */ /****************************************************************************** *** PROC main ***/ PROC main() Rnd(100) /* Version 1.1 will use the date/time to get a really random starting grid */ wflags := IDCMP_CLOSEWINDOW OR IDCMP_MENUPICK OR IDCMP_REFRESHWINDOW OR IDCMP_MOUSEBUTTONS OR IDCMP_GADGETUP OR IDCMP_NEWSIZE rflags := WFLG_DRAGBAR OR WFLG_ACTIVATE OR WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR WFLG_SMART_REFRESH OR WFLG_SIZEGADGET checkerr(openlibs()) cleargrid(1) cleargrid(2) drawgrid() new() /* New goal */ move := 0 /* Number of moves by player=0 */ text() WHILE (parse(Gt_GetIMsg(w.userport)))<>IDCMP_CLOSEWINDOW IF CtrlC() closeall() CleanUp(0) ENDIF WaitTOF() /* This is for multitasking friendlyness */ ENDWHILE closeall() CleanUp(0) ENDPROC /****************************************************************************** *** PROC text *** *** Puts the Row: Col: text in the window ***/ PROC text() DEF i FOR i:=0 TO 2 /* Draw beveled box. Could be replaced with Reqtools func. */ Line(offx+3,basey+(i*15),offx+72, basey+(i*15),1) Line(offx+3,basey+(i*15),offx+3, basey+12+(i*15),1) Line(offx+4,basey+(i*15),offx+4, basey+11+(i*15),1) Line(offx+72,basey+(i*15),offx+72, basey+12+(i*15),2) Line(offx+71,basey+(i*15)+1,offx+71,basey+13+(i*15),2) Line(offx+4,basey+12+(i*15),offx+72, basey+12+(i*15),2) ENDFOR Colour(1,0) TextF(offx+6,basey+9, 'Colms:\d[2]',rows) TextF(offx+6,basey+24,'Rows :\d[2]',columns) TextF(offx+6,basey+39,'Level:\d[2]',level) ENDPROC /****************************************************************************** *** PROC parse *** *** Evaluates the intuition message *** ***/ PROC parse(msg:PTR TO intuimessage) DEF myclass myclass := msg.class SELECT myclass CASE IDCMP_MENUPICK domenu(msg) CASE IDCMP_CLOSEWINDOW RETURN myclass CASE IDCMP_GADGETUP dogadgets(msg) CASE IDCMP_NEWSIZE resize() CASE IDCMP_REFRESHWINDOW Gt_BeginRefresh(w) Gt_EndRefresh(w,TRUE) CASE IDCMP_MOUSEBUTTONS IF dobuttons(msg)=1 THEN RtEZRequestA('You\ave won the game!!!','Ok',0,0,0) ENDSELECT Gt_ReplyIMsg(msg) /* Again, I don't know why. I saw it */ ENDPROC /* in GadToolsDemo, and it couldn't hurt. */ /****************************************************************************** *** PROC domenu *** *** Evaluates the intuition message for menupicks *** ***/ PROC domenu(msg:PTR TO intuimessage) DEF mycode mycode := msg.code SELECT mycode CASE M_ABOUT 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) CASE M_UNDO undo() CASE M_RETRY cleargrid(1) /* Clear player grid, and */ move := 0 /* set the number of moves back to 0 */ CASE M_NEW new() CASE M_QUIT closeall() CleanUp(0) ENDSELECT ENDPROC /****************************************************************************** *** PROC dogadgets *** *** Evaluates the intuition message for gadget presses *** ***/ PROC dogadgets(msg:PTR TO intuimessage) DEF mygad,gad:PTR TO gadget gad:=msg.iaddress mygad := gad.gadgetid SELECT mygad CASE G_UNDO undo() CASE G_RETRY cleargrid(1) move := 0 CASE G_NEW new() CASE G_SLIDER level := msg.code text() new() ENDSELECT ENDPROC /******************************************************************************* *** PROC dobuttons *** *** The actual game routine. Checks if the button click was of the right *** type (buttondown AND leftbutton = $68), checks if the click was in the *** right range (within the grid on the right side of the window), calculates *** in which box the click was made, calls "put", calls to see if the game *** was won with this move, and sets up the undo array. ***/ PROC dobuttons(msg:PTR TO intuimessage) DEF x,y,t,win x:= msg.mousex y:= msg.mousey IF (msg.code = $68) AND (x >= (wx+5)) AND (x <= ((rows*20)+(wx+5))) AND (y >= 16) AND (y <= ((columns*20)+16)) x := (x-(wx+5))/20 y := (y-16)/20 t:=gx[x].y IF t[y] = 0 put(1,x,y,1) win := checkwin() move++ moves[move] := (x*10)+y ENDIF ENDIF ENDPROC win /**************************************************************************** *** PROC undo *** *** Takes back one move. *** ***/ PROC undo() DEF x,y x := moves[move] /10 y := Mod(moves[move],10) IF move <> 0 put(1,x,y,-1) moves[move] := 0 move-- ENDIF ENDPROC /******************************************************************************* *** PROC checkwin *** *** Checks to see if the game is won (by comparing the left grid, goalx, with *** the right grid, gx) ***/ PROC checkwin() DEF i,j,win=1,t,u FOR i := 0 TO (rows-1) t := gx[i].y u := goalx[i].y FOR j := 0 TO (columns-1) IF t[j] <> u[j] THEN win:=0 ENDFOR ENDFOR ENDPROC win /******************************************************************************** *** PROC openlibs *** *** Opens the libraries and sets up the window with gadgets and menus. ***/ PROC openlibs() DEF offs:PTR TO LONG, names:PTR TO LONG, i IF (reqtoolsbase:=OpenLibrary('reqtools.library',37))=NIL THEN RETURN ER_REQTOOLS IF (gadtoolsbase := OpenLibrary('gadtools.library', 37))=NIL THEN RETURN ER_LIB IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN ER_WB IF (visual:=GetVisualInfoA(scr, NIL))=NIL THEN RETURN ER_VISUAL IF (menu:=CreateMenusA([1,0,'Project',0,0,0,0, 2,0,'About',0,0,0,0, 2,0,'Quit','q',0,0,0, 1,0,'Game',0,0,0,0, 2,0,'Undo','u',0,0,0, 2,0,'Retry','a',0,0,0, 2,0,'New','n',0,0,0, 0,0,0,0,0,0,0]:newmenu, NIL))=NIL THEN RETURN ER_MENUS IF LayoutMenusA(menu,visual,NIL)=FALSE THEN RETURN ER_MENUS offx := scr.wborleft + 3 offy := scr.wbortop + 3 basex := (MIN*20)+85+scr.wborleft basey := 78+scr.wbortop wx := (rows*20)+85+scr.wborleft wy := (columns*20)+15 IF wx < basex THEN wx := basex IF wy < basey THEN wy := basey IF (g:=CreateContext({glist}))=NIL THEN RETURN ER_CONTEXT IF (g:=CreateGadgetA(SCROLLER_KIND,g, [offx,offy+120,75,10,NIL,NIL,0,0,visual,0]:newgadget, [GTSL_MIN,1,GTSL_MAX,5,GTSL_LEVEL,5,/*GTSL_MAXLEVELLEN,5,*/GA_RELVERIFY,TRUE, GA_IMMEDIATE,TRUE,GTSC_TOP,0,GTSC_VISIBLE,2,GTSC_TOTAL,5,PGA_FREEDOM, LORIENT_HORIZ,0]))=NIL THEN RETURN ER_GADGET offs := [12,32,52] names := ['Undo','Retry','New'] FOR i := 0 TO 2 IF (g:=CreateGadgetA(BUTTON_KIND,g, [offx,offy+offs[i],75,20,names[i], PLACETEXT_IN, i+1,0,visual,0]:newgadget,NIL))=NIL THEN RETURN ER_GADGET ENDFOR 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 w.minwidth := ((basex*2)-65)+scr.wborright w.minheight := offy+135 w.maxwidth := (MAX*40)+110+scr.wborleft+scr.wborright w.maxheight := (MAX*20)+20 IF SetMenuStrip(w, menu)=FALSE THEN RETURN ER_MENUS Gt_RefreshWindow(w, NIL) SetTopaz(8) /* Maybe someday I'll make the program font-sensitive... */ Colour(1,0) /* Text color */ ENDPROC /************************************************************************** *** PROC closeall *** *** Closes down everything that is open. ***/ PROC closeall() IF w THEN ClearMenuStrip(w) IF menu THEN FreeMenus(menu) IF visual THEN FreeVisualInfo(visual) IF w THEN CloseW(w) IF glist THEN FreeGadgets(glist) IF scr THEN UnlockPubScreen(NIL, scr) IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) IF reqtoolsbase THEN CloseLibrary(reqtoolsbase) ENDPROC /******************************************************************************* *** PROC checkerr *** *** If an error is found during one of the many opening routines (for gadgets, *** windows, libraries, etc.), checkerr gets the return code and displays the *** error. **/ PROC checkerr(err) DEF errors:PTR TO LONG IF err > 0 closeall() errors:=['', 'open gadtools.library v37', 'lock Workbench', 'get visual info', 'create menus', 'open window', 'create context', 'create gadgets', 'open ReqTools'] WriteF('Couldn\at \s!\n', errors[err]) CleanUp(10) ENDIF ENDPROC TRUE /************************************************************************ *** PROC resize *** *** Gets a new usersize for the grid. ***/ PROC resize() DEF buttons,y1 buttons:=offx+80; y1:=offy+10 rows := ((w.width-buttons)-(w.borderright+4)-5)/40 columns := (w.height-(y1+4))/20 wx := (rows*20)+85+scr.wborleft wy := (columns*20)+15 IF wx < basex THEN wx := basex IF wy < basey THEN wy := basey Box(buttons,y1,w.width-(w.borderright+1),w.height-(w.borderbottom+1),0) text() cleargrid(1) /* empty the two grids */ cleargrid(2) drawgrid() /* draw the grids */ new() /* New goal */ ENDPROC /************************************************************************* *** PROC cleargrid *** *** fills the grid with 0s and clears the display grid by calling "put" *** with value 0. ***/ PROC cleargrid(n) DEF i,j,t FOR i := 0 TO (rows-1) IF n = 1 THEN t := gx[i].y ELSE t:=goalx[i].y FOR j := 0 TO (columns-1) t[j] := 0 box(n,i,j,0) ENDFOR ENDFOR ENDPROC /*************************************************************************** *** PROC drawgrid *** *** Draws both grids in the window ***/ PROC drawgrid() DEF i,j,x1,y,x2 FOR i:= 0 TO rows-1 FOR j := 0 TO columns -1 x1 := (i*20)+offx + 80 ; x2 := x1+wx-80 y := (j*20)+offy+10 Line( x1,y, x1+18,y, 2); Line( x2,y, x2+18,y, 2) Line( x1,y, x1,y+18, 2); Line( x2,y, x2,y+18, 2) Line( x1+18,y, x1+18,y+18, 1); Line( x2+18,y, x2+18,y+18, 1) Line( x1,y+18, x1+18,y+18, 1); Line( x2,y+18, x2+18,y+18, 1) ENDFOR ENDFOR ENDPROC /**************************************************************************** *** PROC new *** *** New does a lot of work; it clears the two grids and fills the goal *** grid with a new pattern by randomly choosing empty boxes in the goal *** grid until it is full. It calls "put" and therefore generates a grid *** of a random pattern which is solvable by the player. ***/ PROC new() DEF rnd1,rnd2,i,j,k,x,y, list[MAXUNDOS]:ARRAY OF CHAR cleargrid(1) cleargrid(2) move :=0 FOR i := 0 TO (MAX-1) /* fill an array with all of the */ FOR j := 0 TO (MAX-1) /* boxes. The coordinates are stored*/ list[(i*10)+j] := (i*10)+j /* as complex numbers; (1,1)=11, */ ENDFOR /* (2,1)=22, etc. */ ENDFOR FOR i := 0 TO (MAXUNDOS-2) /* Go through MAXUNDOS times and */ rnd1 := Rnd(MAXUNDOS-2) /* swap two random elements each */ rnd2 := Rnd(MAXUNDOS-2) /* time. This gives us our random */ j := list[rnd1] /* selection. */ list[rnd1] := list[rnd2] list[rnd2] := j ENDFOR k:=0 FOR i := 1 TO rows /* Now we put the boxes in this */ FOR j := 1 TO columns /* random order we've set up. We */ x := list[k]/10 /* have to make sure that each is a */ y := Mod(list[k],10) /* valid box value for the number of*/ k := k+1 /* rows and columns we have. */ WHILE ((x>(rows-1)) OR (y>(columns-1))) AND (k < (MAXUNDOS-1)) x := list[k]/10 /* If it's not valid, we have to */ y := Mod(list[k],10) /* step through the list until we */ k := k+1 /* find one that is. */ ENDWHILE put(2,x,y,1) ENDFOR ENDFOR ENDPROC /**************************************************************************** *** PROC put *** *** Puts a box. n is the grid number (1=gx, 2=goalx), x and y are, of *** course, the box coordinates, and "as" is either 1 or -1. If as is -1, *** then we're undoing boxes; that is, we're taking a box out of the grid, *** rather than putting one in. *** The levels are handled here: *** level 0: Normal play (add to the four primary neighbors) *** level 1: Add to all 8 neighbors *** level 2: Add to primary neighbors and primary neighbors 2 away *** level 3: Add to all 8 neighbors and all neigbors 2 away ***/ PROC put(n,x,y,as) DEF i, j, target,start=-1, end=1 IF level>1 start:=-2; end:=2 ENDIF FOR i := start TO end FOR j := start TO end IF ((i=0) OR (j=0)) OR ((level=1) OR (level=3)) target := IF ((i=0) AND (j=0)) THEN 1 ELSE 0 putsub(n,x+i,y+j,as,target) ENDIF ENDFOR ENDFOR ENDPROC /*********************************************************************** *** PROC putsub *** *** Just an extension routine for put. *** This adds one to x,y if grid[x][y] = 0 AND target = TRUE or if *** grid[x][y]<>0 AND target = FALSE. **/ PROC putsub(n,x,y,as,target) DEF t IF ((x=0) AND (y=0)) IF n=1 THEN t:=gx[x].y ELSE t:=goalx[x].y IF t[y]=0 IF target=1 t[y]:=1 box(n,x,y,t[y]) ENDIF ELSE t[y] := t[y] + as IF t[y] = 5 t[y] := 1 ELSEIF t[y]=0 t[y]:=IF target=1 THEN 0 ELSE 4 ENDIF box(n,x,y,t[y]) ENDIF ENDIF ENDPROC /*********************************************************************** *** PROC box *** *** Draws a colored box in a specified grid coordinate. n is the grid *** number (1=right grid, 2=left grid), x and y are the coordinates, *** and v is the number to draw. If v is (1-4), then box will also put *** the number in the box. If v is 0, then it simply clears the box. ***/ PROC box(n,x,y,v) DEF x1,y1,colors:PTR TO LONG colors := [0,3,4,5,6] x1 := (x*20)+offx + wx IF n = 2 THEN x1 := x1-wx+80 y1 := (y*20)+offy+10 Box( x1+1,y1+1, x1+17,y1+17, colors[v]) Colour(1,colors[v]) IF v>0 THEN TextF(x1+5,y1+11,'\d[1]',v) ENDPROC