/* An ARexx Quiz or Test Runner by John Collett, March 1994 */ 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 /* Set up a window */ address AREXX '"call CreateHost(HO, PORT)"' if ~show('Ports',HO) then address command 'WaitForPort HO' /*flags = 'WINDOWCLOSE + WINDOWDEPTH + WINDOWDRAG + WINDOWSIZING'*/ flags = 'BORDERLESS' ; idcmp = 'GADGETUP' /* PLace 'New page' and 'Quit' gadgets relative to window depth */ wdepth = 230 ; pleft = 200 ; qleft = 300 ; qtop = wdepth - 15 call OpenWindow(HO,0,0,640,wdepth,idcmp, flags) call openport(PORT) ; call ActivateWindow(HO) /* Date and time */ d = date() ; d = left(d,length(d)-5) t = time('c') ; t = left(t,length(t)-2) ; call pat(500,8,d' 't,1) call AddGadget(HO,qleft,qtop,1,"Quit",'%d %g') /* Use the next four lines if 'QuizData' is your source file */ if ~open(qd,'QuizData','r') then do res = Request(150,50,"Can't find QuizData file",,'Okay') signal "Finish" end /* Otherwise, try these two : source = GetFile(150,30,,'QuizData','Select a quiz data file') op = open(qd,source,'r') */ ls = 10 ; count = ls ; tried = 0 ; score = 0 /* Initialisations */ call pat(150,8,'Tried 0',1) ; call pat(250,8,'Score 0',1) line = readln(qd) /* Line by line */ do while ~eof(qd) /* through the file */ count = count + ls if left(line,1) ~= '<' then call pat(10,count,line,1) /* Plain */ else call Command() /* Special */ line = readln(qd) end call close(qd) call GetResponse() /* i.e. 'Quit' click */ Finish: call CloseWindow(HO) ; exit syntax: say 'Syntax : ' errortext(rc) '. Line 'sigl ; signal 'Finish' error: say "Error " rc sigl ; signal 'Finish' /* ----------------------- */ Command: /* Any line starting with '<' */ type = upper(substr(line,2,1)) l = length(line) ; line = substr(line,3,l) select when type = 'Q' then call Answer(1) /* Question */ when type = 'F' then call Answer(2) /* Fill in */ when type = 'P' then call NewPage() /* New page */ when type = 'T' then call Title(1) /* Title */ when type = 'S' then call Title(2) /* Subtitle */ when type = 'L' then do /* Linespace */ ls = line ; count = count - ls ; end when type = 'M' then call Multi() /* Multichoice */ when type = '!' then count = count - ls /* Comments in */ /* data file. */ otherwise end return Answer: /* Prepare question and gadget for answer */ qtype = arg(1) aa = index(line,'{') ; zz = index(line,'}') head = substr(line,1,aa-1) alen = zz - aa -1 ; answer = substr(line,aa+1,alen) alen = alen + RND() if qtype = 1 then mid = '' ; else mid = copies('_',alen) tail = substr(line,zz+1,l-zz) q = head || mid || tail ; full = head || answer || tail call pat(10,count,q,2) ; top = count - 7 width = alen * 8 ; left = 620 - width toolong = (left < l*8) if toolong then do ; left = 620 - width ; top = top + ls ; end call AddGadget(HO,left,top,2,'','%d %g',width) ; given = '' do until given ~= '' call ActivateGadget(HO,2) ; call GetResponse() ; end call RemoveGadget(HO,2) return GetResponse: /* Which gadget selected? */ call waitpkt(PORT) ; p = getpkt(PORT) if p ~== NULL() then do i = getarg(p) ; t = reply(p, 0) ; parse var i gadno txt select when gadno = 1 then signal 'Finish' when gadno = 2 then do /* String entry */ if txt ~= '' then do correct = (upper(txt) = upper(answer)) tried = tried + 1 ; call SetBPen(HO,3) call pat(198,8,' 'tried' ',1) ; call SetBPen(HO,0) if correct then do /* Erase gadget */ call APen(0); call RectFill(HO,left-2,top,left+width+1,top+9) call APen(1) ; call UpScore() end call pat(10,count,full || ' ',2) count = count + toolong*ls ; given = txt end end when gadno = 3 then turn_okay = 1 /* New page */ when gadno = goodchoice then call UpScore /* Multichoice */ otherwise end end return UpScore: score = score + 1 ; call SetBPen(HO,3) call pat(298,8,' 'score' ',1) ; call SetBPen(HO,0) return NewPage: /* Create gadget, wait for it to be clicked, then remove it */ a = "Next page" ; call AddGadget(HO,pleft,qtop,3,a,'%d %g') turn_okay = 0 do until turn_okay = 1 ; call GetResponse() ; end count = 2 * ls ; call RemoveGadget(HO,3) ; call APen(0) call RectFill(HO,0,10,640,qtop-2) call RectFill(HO,pleft-2,qtop-2,qleft-2,qtop+10) ; call APen(1) return Title: /* and subtitle */ call SetFont(HO,'topaz.font',13 - 2*arg(1)) ; tline = '' if arg(1) = 1 then do do i = 1 to length(line) c = substr(line,i,1) ; tline = tline || c || ' ' /* Spaced */ end call shad(8 * (40 - length(line)),count+6,tline) /* Centered */ end else call shad(10,count+6,line) call SetFont(HO,'topaz.font',8) count = count + 9 - arg(1) return Multi: nlines = line ; if nlines = '' then nlines = 1 /* Default value 1 */ gadn = 2 ; count = count - 4 do linecount = 1 to nlines /* A gadget per choice */ line = readln(qd) ; s = 1 do forever aa = index(line,'{',s) ; if aa = 0 then leave zz = index(line,'}',s) ; if zz = 0 then leave s = zz + 1 ; gleft = aa*8 - 4 ; gright = zz*8 + 4 gadtxt = substr(line,aa+1,zz-aa-1) gadn = gadn + 1 ; star = index(gadtxt,'*') if star ~= 0 then do ; /* The correct one */ gadtxt = delstr(gadtxt,star,1) ; goodchoice = gadn goodleft = gleft ; goodright = gright ; goodtop = count end call AddGadget(HO,gleft,count,gadn,gadtxt,'%d %g') end /* of 'do forever' */ count = count + 14 end /* of 'do linecount' */ call GetResponse() call APen(3) ; w = goodright-goodleft /* Frame correct choice */ call DrawBox(goodleft-4,goodtop-2,w-13,13) ; call APen(1) do g = 3 to gadn ; call RemoveGadget(HO,g) ; end return DrawBox: parse arg x,y,w,h call Move(HO,x,y) ; call Draw(HO,x+w,y) ; call Draw(HO,x+w,y+h) call Draw(HO,x,y+h) ; call Draw(HO,x,y) return pat: if arg() = 4 then call APen(arg(4)) call Move(HO,arg(1),arg(2)) ; call Text(HO,arg(3)) return shad: call SetDrMd(HO,JAM1) call Move(HO,arg(1)+2,arg(2)+1) ; call Text(HO,arg(3)) call APen(2) ; call Move(HO,arg(1),arg(2)) ; call Text(HO,arg(3)) call SetDrMd(HO,JAM2) ; call APen(1) return APen: call SetAPen(HO,arg(1)) ; return /* This little function makes the slots for answers slightly longer than needed, by a random amount, so that the apparent length of an answer is not in itself a clue to the answer. */ RND: return random(2,4)