/* */ /* MiniLinks - a kind of hypertext */ /* By John Collett August 1994 */ /* Written in ARexx. Needs 'rexxarplib.library'. */ /* Various commands possible if run from CLI : 1 rx MiniLinks (or if run from an icon) 2 rx MiniLinks FileNameN 3 rx MiniLinks FileNameN xy 4 rx MiniLinks FileNameN Anything_but_xy 1 The program will screen Script1. 2 The program will screen FileNameN. 3 The program will screen FileNameN. Pointer position updates will be available for screen planning, but text links will be inoperative. 4 Program will close screen and exit - handy for getting out of a fix. */ signal on syntax ; signal on error if ~show('l','rexxarplib.library') then do check = addlib('rexxsupport.library',0,-30,0) check = addlib('rexxarplib.library',0,-30,0) end xy = 0 ; parse arg choice s . if s ~= '' then if s ~= 'xy' then signal 'Finish' ; else xy = 1 /* Create window */ address AREXX '"call CreateHost(HO, PORT)"' if ~show('Ports',HO) then address command 'WaitForPort HO' /*flags = 'WINDOWCLOSE + WINDOWDEPTH + WINDOWDRAG + WINDOWSIZING'*/ flags = 'BORDERLESS+WINDOWCLOSE' idcmp = 'CLOSEWINDOW + GADGETUP + MOUSEBUTTONS + RAWKEY' foot = 256 ; call OpenWindow(HO,0,0,640,foot,idcmp, flags) call openport(PORT) ; call ActivateWindow(HO) /* Set colours */ c.0 = '6 9 13' ; c.1 = '0 0 2' ; c.2 = '15 15 15' ; c.3 = '15 9 4' c.4 = '14 1 1' ; c.5 = '0 15 0' ; c.6 = '0 0 11' ; c.7 = '15 15 0' do i = 0 to 7 ; parse var c.i r g b . ; call SetRGB4(HO,i,r,g,b) ; end call ModifyHost(HO,'MOUSEBUTTONS','%l %b %x %y') call ModifyHost(HO,'RAWKEY','%l %c') /* Gadgets to get previous page, next page, and new script set */ call AddGadget(HO,564,1,1,'<-','%l %d') call AddGadget(HO,588,1,2,'->','%l %d') call AddGadget(HO,612,1,3,'??','%l %d') gadno = 0 /* Does the default script set exist? If not, use a file requester. */ if choice ~= '' then call Analyze(choice) else do ok = exists("Script1") if ok then do scriptname = 'Script' ; scriptno = 1 script = scriptname || scriptno ; end else call GetName() if scriptname = '' then signal 'Finish' end /* Scripts after the first : up/down in series, or new set? */ GetScript: call clear(2) if gadno = 2 then scriptno = scriptno + 1 else if gadno = 1 & scriptno > 1 then scriptno = scriptno - 1 script = scriptname || scriptno ok = exists(script) if (~ok) | gadno = 3 then do call GetName() ; if scriptname = '' then signal 'Finish' end /* Load in main text */ op = open(sc,script,'r') ; if op = 0 then signal 'Finish' call clear(1) ; str = '' ; i = 0 do forever i = i + 1 ; s.i = readln(sc) ; if strip(s.i) = '<' then leave str = str || s.i || '\' end call WindowText(HO,compress(str,'`')) ; gadpos = (i+3) * 9 call pat(30,7,script) /* Read in the comments on each highlighted chunk. */ wc = 0 ; word. = '' ; x1. = 0 ; x2. = 0 ; y. = 0 do j = 1 to i call Underline(s.j) ; s.j = compress(s.j,'`') end /* Concatenate multi-line comments into a single string, including '\' at each line break, until they are needed. */ do c = 1 to wc comment.c = '' do forever patch = readln(sc) ; if strip(patch) = '' | eof(sc) then leave comment.c = comment.c || patch || '\' end end /* 'Interpret' any remaining lines - graphics etc. */ if ~eof(sc) then do until eof(sc) instruction = readln(sc) interpret instruction end cl = close(sc) ; call pat(260,gadpos,'Ready',1) ; call SetDrMd(HO,JAM1) call pat(258,gadpos-1,'Ready',2) ; call APen(1) ; call SetDrMd(HO,JAM2) /* Screen ready for use. Clicks can be on the 'Close' gadget, next or previous page gadget, new script gadget, or an underlined chunk. */ do forever call waitpkt(PORT) ; p = getpkt(PORT) if p ~== NULL() then do i = getarg(p) ; t = reply(p, 0) parse var i class gadno rest select when class = 'CLOSEWINDOW' then signal 'Finish' when class = 'GADGETUP' then signal 'GetScript' when class = 'RAWKEY' & (gadno < 80) then do gadno = 80-gadno ; signal 'GetScript' ; end when class = 'MOUSEBUTTONS' then call WordClick() otherwise end /* of 'select' */ end /* of 'if ... then do' */ end /* of 'do forever' */ Finish: call CloseWindow(HO) ; exit syntax: say 'Syntax : ' errortext(rc) '. Line 'sigl ; signal 'Finish' error: say "Error " rc sigl ; signal 'Finish' GetName: /* User selects own script set */ choice = GetFile(150,30,,,'Select a script') if choice = '' then signal 'Finish' call Analyze(choice) return Analyze: /* Extract name and number from choice. */ choice = arg(1) do c = length(choice) to 1 by -1 char = substr(choice,c,1) ; if datatype(char,'m') then leave end if c = length(choice) then do aa = "Files in script sets must be made\up of a name and a number.", "\Default set is Script1, Script2, etc.", "\Select Cancel in the next file", "\requester if you want to quit." call clear(2) ; r = Request(50,50,aa,,'Okay') call GetName() end /* of 'if c = ...' */ else call Divide() return Divide: /* Divide choice into name and number */ scriptname = substr(choice,1,c) scriptno = substr(choice,c+1,length(choice)-c) script = scriptname || scriptno return /* Underline chunks which are marked `thus`. */ Underline: st = arg(1) ; find = 1 ; call Apen(2) do forever a1 = -1 ; aa = 1 ; adj = 0 do until a1 = 0 a1 = index(st,"`",aa) ; if a1 = 0 then leave a2 = index(st,"`",a1+1) /* Find partner/next space/end of line. */ if a2 = 0 then do a2 = index(st," ",a1+1) if a2 = 0 then a2 = length(st)+1 end wc = wc + 1 ; adj = adj + 1 /* Adjust text when markers removed */ w = substr(st,a1+1,a2-a1-1) word = strip(w,'t','.,?!";:') /* Remove punctuation */ if length(w) ~= length(word) then a2 = a2 - 1 word.wc = word ; x1.wc = a1*8 + 28 - adj*16 x2.wc = x1.wc + length(word)*8 ; y.wc = (j+2)*9 call Move(HO,x1.wc,y.wc) ; call Draw(HO,x2.wc,y.wc) aa = a2 + 1 end return /* Was the click on an underlined chunk? */ WordClick: parse var i class state x y if state = 'SELECTUP' then return if xy = 1 then do ; call pat(230,8,x y ' ') ; return ; end found = 0 ; n = 0 do until found | (n = wc) n = n + 1 found = ((x > x1.n) & (x < x2.n) & (y > y.n-9) & (y < y.n)) end if ~found then return call Apen(3) ; call Move(HO,x1.n,y.n -1) call Draw(HO,x2.n,y.n -1) ; call APen(1) /* Redivide comment into line segments. Center on longest seg. */ thisy = gadpos ; cmt = comment.n ; lin. = '' ; m = 0 ; max = 0 do forever m = m + 1 ; slash = index(cmt,'\') if slash = 0 then do lin.m = cmt ; max = max(max,length(cmt)) ; leave ; end lin.m = substr(cmt,1,slash-1) ; max = max(max,length(lin.m)) cmt = substr(cmt,slash+1,length(cmt)-slash) end /* Position comment box below end of main text (if room) */ thisx = (620 - max*8) % 2 if gadpos+m*8-4 < foot then do call clear(3) ; m = m - 1 call NoteBox(thisx-8,gadpos-8,thisx+max*8+8,gadpos+m*8-4) call SetBPen(HO,2) do p = 1 to m ; call pat(thisx,thisy,lin.p) ; thisy = thisy + 8 ; end call SetBPen(HO,0) end else do com = strip(comment.n,'t','\') call clear(1) ; req = Request(thisx-8,foot - 30 - 9*m,com,,) call clear(1) ; call pat(30,7,script) end return /* Remaining functions are just useful shortcuts for various jobs */ clear: call APen(0) select when arg(1) = 1 then call RectFill(HO,20,1,640,10) when arg(1) = 2 then call RectFill(HO,0,0,640,foot) otherwise call RectFill(HO,0,gadpos-9,640,foot) end call APen(1) ; call RefreshGadgets(HO) ; return NoteBox: parse arg lf,up,rt,bot . ; call APen(1) ; call RectFill(HO,lf,up,rt,bot) call APen(2) ; call RectFill(HO,lf+2,up+1,rt-2,bot-1) ; call APen(1) return 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 Rect: parse arg lf,up,rt,bot,edge1,edge2 . ; call SetAPen(HO,edge1) call Move(HO,lf,up) ; call Draw(HO,rt,up) call SetAPen(HO,edge2) ; call Move(HO,lf,bot) ; call Draw(HO,rt,bot) do u = 0 to 1 ; call Move(HO,rt-u,up+u) ; call Draw(HO,rt-u,bot) ; end call SetAPen(HO,edge1) do u = 0 to 1 ; call Move(HO,lf+u,bot-u) ; call Draw(HO,lf+u,up) ; end call SetAPen(HO,1) return ----------- Hamilton, New Zealand August 1944 ----------