DEFINT A-Z SGFtoLoad$ = "test.sgf" TYPE SGFnode ' An attribute that pertains to a move tag AS STRING*2 offs AS INTEGER ' Location in file (or link to first move if tag = "( ") link AS INTEGER ' Link to the next node associated with this move END TYPE TYPE SGFmove offs AS INTEGER ' Link to first node link AS INTEGER ' Link to next move in this series END TYPE DIM SHARED c$, node(2000) AS SGFnode, move(2000) AS SGFmove DIM SHARED nodecount, movecount DIM SHARED dither8x8(8,8) AS SINGLE, Font6x5(96,5), Font6x7(96,7) DIM SHARED boardstate(19*19), captures(2), remtime(2) AS SINGLE, names$(2) DIM SHARED background(34), commenty, commentmovebuf(7684) DIM SHARED shine!, shinecenterx, shinecentery, hlt(1) CONST ActiveTimeColor = 14, PassivetimeColor = 10 CONST PlayerKibitzColor = 14, OtherKibitzColor = 7, ShadowKibitzColor = 8 CONST PlayerNameColor = 14, PlayerNameSurpriseColor = 7 CONST StatusKibitzColor = 15 CONST LoadingDotsColor = 6 CONST GammaColorStart = 50 hlt(0) = &HCBF4' HLT; RETF. DrawInitialize DrawText 20,190,"Initializing graphics...",11 'FOR y=0 TO 7: FOR x=0 TO 7: SetP x,y, 20,10,90: NEXT x,y FOR y=0 TO 7: FOR x=0 TO 7: SetP x,y, 70,40,3: NEXT x,y GET(0,0)-(7,7),background FOR y=0 TO 192 STEP 8:FOR x=0 TO 312 STEP 8:Put(x,y),background,PSET:NEXT x,y c$ = CHR$(10) s$ = "Real-time KGS gamelog replayer written"+c$ DrawText 216,170,s$+"by Joel Yliluoma"+c$+"in 2011-02-18", 6 'DrawFontSamples OPEN SGFtoLoad$ AS #1 LEN=1: FIELD #1, 1 AS c$ ON ERROR GOTO GameOver tmp = DrawText2(1,1, "Loading "+SGFtoLoad$, 0) tmp = DrawText2(0,0, "Loading "+SGFtoLoad$, 15) root = SGFparse(1) ' Parse SGF file 'On 320x200, to fit 19x19 goban, each cell can maximally be 12x10. 'To allow some room for the chat window, we'll make it 10x8. 'Thus, it becomes 190x152. 'But to allow coordinates on each size and at top, 21x20 -> 210x160. DEF FNx(x) = x*10 DEF FNy(y) = y*8-3 FOR y=0 TO 19: SOUND 40+RND*30,0.1 FOR x=0 TO 20: DrawBoard x,y, 0,0:NEXT x,y DrawBoardDecorations GameRun 0 GameOver: IF ERR = 90 THEN STOP SCREEN 0,1,0,0 WIDTH 80,25 PRINT "End" END END IF ON ERROR GOTO 0 RESUME ' Parse a SGF file or a structure in the file. This function is recursive. FUNCTION SGFparse(beginoffset) n1 = -1 ' First node number (will be saved to move.offs) pn = -1 ' Previous node number (will be saved to node.link) pm = -1 ' Previous move number (will be saved to move.link) GET #1, beginoffset: IF c$ <> "(" THEN ERROR 2 ' syntax error tag$ = "" x=72:y=0 DO y$ = INKEY$ IF y$ = "q" OR y$ = CHR$(27) OR y$ = CHR$(3) THEN ERROR 90 GET #1: k = ASC(c$) playstep=playstep+1 IF playstep=15 THEN playstep=0:PLAY "MB MSt255 O6g64e64" tmp=DrawChar2(x+1,y+1, 46, 0) x=x+DrawChar2(x,y, 46, LoadingDotsColor): IF x>206 THEN x=0: y=y+3 IF EOF(1) OR k = 59 OR k = 41 THEN 'New turn if ";" or ")" move(movecount).offs = n1 'New turn. Add move. IF pm >= 0 THEN move(pm).link = movecount n1 = -1 ' Begin new node-chain pn = -1 pm = movecount 'Save previous move number DrawTextCaption 216,5, "Move", STR$(movecount-2), 2 movecount = movecount + 1 IF k <> 59 THEN EXIT DO 'eof and ")" terminate the parsing loop. ELSEIF k > 32 THEN 'Ignore blanks between tags IF k = 40 THEN 'Recurse on "(" beginpos = SGFparse(LOC(1)) tag$ = "(" ELSE IF k <> 91 THEN 'Read tag name unless "[" immediately follows tag$ = "" WHILE k <> 91 AND NOT EOF(1) IF k >= 65 AND k <= 90 THEN tag$ = tag$ + c$ 'Add only A-Z GET #1: k = ASC(c$) WEND IF k <> 91 THEN ERROR 2 'After the tag should be values, in brackets. END IF 'Read value beginpos = LOC(1)+1 value$ = SGFreadString$(beginpos) END IF 'Add to tree nodecount = nodecount + 1 'Ensure node numbers begin from 1 by preincrementing. node(nodecount).tag = tag$ node(nodecount).offs = beginpos SELECT CASE tag$ CASE "KM" 'draw komi DrawTextCaption 270,5, "Komi:", value$, 10 CASE "HA" 'draw handicap DrawTextCaption 270,20, "Handicap:", value$, 10 CASE "PB" 'set black player name DrawTextCaption 270,40, "Black:", "???", PlayerNameSurpriseColor CASE "PW" 'set white player name DrawTextCaption 216,40, "White:", "???", PlayerNameSurpriseColor CASE "BR" 'set black player rank DrawText 308,46, value$, 10 CASE "WR" 'set white player rank DrawText 256,46, value$, 10 CASE "DT" 'set datetime DrawText 264,100, value$, 14 CASE "PC" 'set place DrawText 216,100, "Played at:", 15 DrawText 212,106, value$, 10 CASE "TM" 'set time t! = VAL(value$) remtime(1) = t! remtime(2) = t! DrawTextCaption 216,58, "Time:", strtime$(remtime(1)), PassiveTimeColor DrawTextCaption 270,58, "Time:", strtime$(remtime(2)), PassiveTimeColor END SELECT IF pn >= 0 THEN node(pn).link = nodecount IF n1 = -1 THEN n1 = nodecount 'Save first node number pn = nodecount 'Save previous node number END IF LOOP DrawTextCaption 216,5, "Loading", "Complete", 2 SGFparse = pm END SUB ' Read a string from SGF file, parsing escapes and terminating on EOF or "]" FUNCTION SGFreadString$(beginpos) value$ = "" SEEK #1, beginpos 1 DO GET #1: k = ASC(c$) IF k = 93 OR EOF(1) THEN EXIT DO ' EOF or "]" terminate string. IF k = 92 THEN GET #1: k = ASC(c$): IF k < 32 THEN 1 value$ = value$ + c$ LOOP SGFreadString = value$ END SUB SUB SGFdump(moveid, indent) nodeid = move(moveid).offs DO WHILE nodeid > 0 IF node(nodeid).tag = "( " THEN SGFdump node(nodeid).offs, indent+2 ELSE s$ = SGFreadString$( node(nodeid).offs ) ?SPC(indent) "<";node(nodeid).tag;">"; s$ END IF nodeid = node(nodeid).link WEND ' loop node-chain moveid = move(moveid).link LOOP WHILE moveid > 0 'loop next-move END SUB FUNCTION SGFfindTag$(moveid, tag$) nodeid = move(moveid).offs WHILE nodeid > 0 IF node(nodeid).tag = tag$ THEN SGFfindTag$ = SGFreadString$( node(nodeid).offs ) EXIT SUB END IF nodeid = node(nodeid).link WEND ' loop node-chain END FUNCTION SUB DrawSetPalette(begin, gamma!) OUT &H3C8, 13 IF gamma! > 1 THEN OUT &H3C9, ABS(gamma!-1)*38 OUT &H3C9, ABS(gamma!-1)*33 OUT &H3C9, ABS(gamma!-1)*20 ELSE OUT &H3C9, ABS(gamma!-1)*78 OUT &H3C9, ABS(gamma!-1)*73 OUT &H3C9, ABS(gamma!-1)*60 END IF OUT &H3C8, 16+begin FOR r=0 TO 5: FOR g=0 TO 7: FOR b=0 TO 4 IF begin > 0 THEN begin=begin-1 ELSE IF gamma! = 1.0 THEN OUT &H3C9, r*12.6 OUT &H3C9, g*9 OUT &H3C9, b*15.75 ELSE rr! = (r/5)^gamma! gg! = (g/7)^gamma! bb! = (b/4)^gamma! OUT &H3C9, INT(rr! * 63.9) OUT &H3C9, INT(gg! * 63.9) OUT &H3C9, INT(bb! * 63.9) END IF END IF NEXT b,g,r END SUB SUB DrawInitialize SCREEN 13 'Set up a 6*8*5 linear 240-color palette. 'Btw. 252 would allow 9*7*4 or 6*6*7... DrawSetPalette 0, 1.0 DrawSetPalette gammaColorStart, 1.8 ' Set up a 8x8 bayer ordered dithering matrix. FOR y=0 TO 7: FOR x=0 TO 7 q = x XOR y p = (x AND 4)\4 + (x AND 2)*2 + (x AND 1)*16 q = (q AND 4)\2 + (q AND 2)*4 + (q AND 1)*32 dither8x8(y,x) = ((p+q)) / 64.0 NEXT x,y DEF SEG = &HA000 FOR y=0 TO 94: FOR x=0 TO 5: READ Font6x5(y,x): NEXT x,y FOR y=0 TO 94: FOR x=0 TO 7: READ Font6x7(y,x): NEXT x,y 'FOR x=0 TO 255:LINE(x,0)-(x,199),x:NEXT END SUB 'Draw a RGB pixel. Give RGB in 0..999 range. Uses dithering. SUB SetP(x,y, r,g,b) q! = dither8x8(y AND 7, x AND 7) rr = INT(r * 0.005005005005! + q!) ' 5/999 gg = INT(g * 0.007007007007! + q!) ' 7/999 bb = INT(b * 0.004004004004! + q!) ' 4/999 POKE y * 320& + x, 16 + bb + gg*5 + rr*40 END SUB ' Draw a character ch at given coordinates using color c. ' No dithering. No kerning. Return value: Width. FUNCTION DrawChar1(x,y, chn, c) ch = CharIdx(chn) w = Font6x5(ch, 0) IF c >= 0 THEN FOR py = 1 TO 5 p = Font6x5(ch, py) o& = (y+py-1) * 320& + x m = 128 FOR px = 1 TO w IF p AND m THEN POKE o&, c o& = o& + 1 m=m\2 NEXT px,py END IF DrawChar1 = w END SUB FUNCTION CharIdx(chn) ch = chn IF ch > 127 THEN ch = 85 ' assume "U" IF ch >= 32 THEN ch = ch - 32 CharIdx = ch END SUB FUNCTION DrawChar2(x,y, chn, c) ch = CharIdx(chn) w = Font6x7(ch, 0) IF c >= 0 THEN FOR py = 1 TO 7 p = Font6x7(ch, py) o& = (y+py-1) * 320& + x m = 128 FOR px = 1 TO w IF p AND m THEN POKE o&, c o& = o& + 1 m=m\2 NEXT px,py END IF DrawChar2 = w END SUB SUB DrawText(bx,by, value$, c) tmp = DrawText1(bx,by,value$,c) END SUB FUNCTION DrawText1(bx,by, value$, c) l = LEN(value$) x = bx: y = by x1 = x FOR a = 1 TO l ch = ASC(MID$(value$, a, 1)) IF ch = 32 THEN 'wrap if necessary wordlen = 0 FOR b = a+1 TO l ch = ASC(MID$(value$, b, 1)) IF ch = 32 THEN EXIT FOR wordlen = wordlen + Font6x5(CharIdx(ch), 0) NEXT IF x+wordlen >= 320 THEN x = x1:y=y+6 ELSE x = x+4 ELSEIF ch = 10 THEN x = x1: y = y+6 ELSE x = x + DrawChar1(x,y, ch, c) END IF NEXT DrawText1 = y-by+6 END SUB ' Draw text and return height in pixels FUNCTION DrawText2(bx,by, value$, c) l = LEN(value$) x = bx: y = by x1 = x FOR a = 1 TO l ch = ASC(MID$(value$, a, 1)) IF ch = 32 THEN 'wrap if necessary wordlen = 0 FOR b = a+1 TO l ch = ASC(MID$(value$, b, 1)) IF ch = 32 THEN EXIT FOR wordlen = wordlen + Font6x7(CharIdx(ch), 0) NEXT IF x+wordlen >= 320 THEN x = x1:y=y+7 ELSE x = x+4 ELSEIF ch = 10 THEN x = x1: y = y+7 ELSE x = x + DrawChar2(x,y, ch, c) END IF NEXT DrawText2 = y-by+7 END SUB SUB DrawBoard(bx,by, stone, mark) yp = FNy(by) xp = FNx(bx) ' Optional features: ' Board markings: ' Line left, right, up, down ' Dot in the middle ' Stone: ' White stone ' Black stone ' IF bx=0 OR bx=20 OR by=0 THEN linemask = 0 ELSE linemask = 15 + (bx=1) + (bx=19)*2 + (by=1)*4 + (by=19)*8 END IF hoshi = (bx=4 OR bx=10 OR bx=16) AND (by=4 OR by=10 OR by=16) hm1 = FNy(by+1)-yp-1 wm1 = FNx(bx+1)-xp-1 'stone = (bx+by)MOD 3 'mark=1 stonevalue = 0 IF stone = 1 THEN stonevalue = 970: stonesize! = 4.2 ELSEIF stone = 2 THEN stonevalue = 170: stonesize! = 4.05 END IF IF stonevalue THEN 'Highlight spot on the stone; location is random spotx! = wm1/2 + wm1 * .3 * COS((bx+by*19)*17) spoty! = hm1/2 + hm1 * .3 * SIN((bx+by*19)*17) END IF FOR y=0 TO hm1 FOR x1=0 TO wm1 x = x1 + xp r = 900*.82 +10*COS((x+yp)*.1) g = 786*.70 +20*SIN(x*.1) b = 375*.65 IF y=4 OR x1=5 THEN ' Check line drawing horizmask = (x1<=5)*1 + (x1>=5)*2 vertmask = (y<=4)*4 + (y>=4)*8 IF (linemask AND -horizmask)<>0 AND (linemask AND -vertmask)<>0 THEN r = r \ 2 g = g \ 2 b = b \ 2 END IF END IF IF hoshi AND (ABS(y-4)<2 AND ABS(x1-5)<2) THEN r=r*3\5 g=g*3\5 b=b*3\5 END IF IF shine! > 0.15 THEN sdx! = ABS(shinecenterx-x)/1.2 sdy! = ABS(shinecentery-yp) sd! = SQR(sdx!*sdx! + sdy!*sdy!) * (8+(sdx!)*(sdy!)) shinelevel! = (shine!*shine!) / (1 + sd!*sd!) r = r + shinelevel!*7e5 g = g + shinelevel!*7e5 b = b + shinelevel!*7e6 IF r > 999 THEN r = 999 IF g > 999 THEN g = 999 IF b > 999 THEN b = 999 END IF IF stonevalue THEN dy! = (y - hm1/2) dx! = (x1 - wm1/2)/1.2 dist! = SQR(dx! * dx! + dy! * dy!) IF dist! < stonesize! THEN ' Stone color + stripe detail + roundness l = stonevalue + 19 * sin((x+yp)*.7) - dist!*70 ' Add specular highlight spot dy! = (y - spoty!) dx! = (x1 - spotx!)/1.2 dist2! = dx! * dx! + dy! * dy! IF dist2! < 2 THEN l = l + 340-dist2!*100 ' Clamp IF l>999 THEN l=999 ELSE IF l<0 THEN l=0 IF mark AND dist! >= 0.7 AND dist! <= 1.7 THEN power! = 1.7-dist! l = l*power! + (999-l)*(1-power!) END IF IF dist! >= 3.8 THEN 'antialias (mix with board gfx) r = (r+l)/2 g = (g+l)/2 b = (b+l)/2 ELSE r = l g = l b = l END IF END IF END IF SetP x,yp, r,g,b NEXT yp=yp+1 NEXT 'IF mark THEN ' LINE (xp+3,yp-6)-(xp+6,yp-3), 12,BF 'END IF END SUB SUB DrawBoardDecorations c=65 colour = 13 FOR y=1 TO 19 s$ = str$(19-y+1) x = 0 IF 19-y+1 >= 10 THEN x = x - 2 DrawText FNx(0)+x, FNy(y)+2, s$, colour DrawText FNx(20)+x-2,FNy(y)+2, s$, colour DrawText FNx(y)+4, FNy(0)+3, CHR$(c), colour c=c+1 IF c=73 THEN c=c+1 ' Skip over "I" NEXT END SUB SUB DrawFontSamples tmp = DrawText2(0,100, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 2) tmp = DrawText2(0,110, "abcdefghijklmnopqrstuvwxyz", 2) tmp = DrawText1(0,120, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 2) tmp = DrawText1(0,128, "abcdefghijklmnopqrstuvwxyz", 2) END SUB FUNCTION CheckCapture(bx,by, samecolour, captureroffs) DIM pending(256) DIM state(19*19) liberties = 0 pendinghead = 0 pendingtail = 0 x = bx y = by offs = y * 19 + x DO ' With a djikstra breadth-first floodfill algorithm, ' find out what the extents of this group are. ' At the edges of the group are either board's edges, ' opponent's stones, or empty intersections. ' Only empty intersections count as liberties. ' If the group has no liberties left, it ' is captured and removed from the board. IF state(offs) = 0 THEN state(offs) = 1 SELECT CASE boardstate(offs) CASE 0 liberties = liberties + 1 CASE samecolour IF x > 0 THEN IF state(offs-1) = 0 THEN pending(pendinghead) = offs-1 pendinghead = (pendinghead + 1) AND 255 END IF END IF IF x < 18 THEN IF state(offs+1) = 0 THEN pending(pendinghead) = offs+1 pendinghead = (pendinghead + 1) AND 255 END IF END IF IF y > 0 THEN IF state(offs-19) = 0 THEN pending(pendinghead) = offs-19 pendinghead = (pendinghead + 1) AND 255 END IF END IF IF y < 18 THEN IF state(offs+19) = 0 THEN pending(pendinghead) = offs+19 pendinghead = (pendinghead + 1) AND 255 END IF END IF END SELECT END IF IF pendingtail = pendinghead THEN EXIT DO offs = pending(pendingtail) pendingtail = (pendingtail+1)AND 255 x = offs MOD 19 y = offs \ 19 LOOP IF liberties = 0 THEN captures = 0 FOR y = 0 TO 18 FOR x = 0 TO 18 offs = y*19 + x IF state(offs) AND (boardstate(offs) = samecolour) THEN boardstate(offs) = 0 DrawBoard x+1, y+1, 0, 0 captures = captures + 1 END IF NEXT x,y ' Return value: The number of captured stones CheckCapture = captures ' If the capturer was just one stone, whose only liberty ' is in the spot that was just freed, mark a "ko". ' Note: Remember to unmark the "ko" later. END IF END SUB SUB GamePlayStone(x,y, colour) offs = y * 19 + x boardstate(offs) = colour opponent = 3-colour c = 0 IF x>0 THEN IF boardstate(offs-1) = opponent THEN c = c + CheckCapture(x-1,y, opponent, offs) END IF IF x<19-1 THEN IF boardstate(offs+1) = opponent THEN c = c + CheckCapture(x+1,y, opponent, offs) END IF IF y>0 THEN IF boardstate(offs-19) = opponent THEN c = c + CheckCapture(x,y-1, opponent, offs) END IF IF y<19-1 THEN IF boardstate(offs+19) = opponent THEN c = c + CheckCapture(x,y+1, opponent, offs) END IF IF c > 0 THEN PLAY "mst255 l32 o2 a>e>c" captures(colour) = captures(colour) + c x = 216 + (colour-1)*54 DrawTextCaption x,80, MID$("WB",colour,1)+" capture", "+"+STR$(captures(colour)),10 END IF END SUB SUB DrawTextCaption(xp,yp, label$, text$, colour) x1 = xp AND &HFF8 y1 = yp AND &HFF8 x2 = x1 + 24 IF LEN(label$) > 7 OR LEN(text$) > 7 THEN x2 = x2 + 16 IF x2 > 312 THEN x2=312 FOR x = x1 TO x2 STEP 8 PUT(x, y1), background, PSET PUT(x, y1+8), background, PSET NEXT DrawText xp+1,yp+1, label$, 0 DrawText xp+1,yp+7, text$, 0 DrawText xp,yp, label$, 15 DrawText xp,yp+6, text$, colour END SUB SUB DrawCommentLine(comment$, size, moveno) 'DrawTextCaption 0,0, "commenty", str$(commenty)+comment$,15 ' Calculate how much room the text needs miny = FNy(20) IF size = 2 THEN STATIC prevmoveno IF moveno+1 <> prevmoveno THEN prevmoveno = moveno+1 IF moveno = 0 THEN DrawCommentLine "Game Start", 1, moveno ELSE DrawCommentLine "Move"+STR$(moveno), 1, moveno END IF END IF height = DrawText2(2,0, comment$, -1) ELSE height = DrawText1(2,0, comment$, -1) END IF roomneeded = (commenty+height)-200 IF roomneeded > 0 THEN ' Round up the room to 8 roomneeded = (roomneeded+7)AND &HF8 ' Roomneeded = height of empty in the bottom of screen movesize = (200-miny) - roomneeded x2 = FNx(21) 'Scroll the text window up GET(0, miny+roomneeded)-(x2-1,199), commentmovebuf PUT(0, miny), commentmovebuf, PSET GET(x2,126+roomneeded)-(319,199), commentmovebuf PUT(x2,126), commentmovebuf, PSET 'Clear the bottom part that is now free FOR y = miny+movesize TO 192 STEP 8 FOR x = 0 TO 312 STEP 8 PUT (x,y), background, PSET NEXT x,y 'Render shadows FOR y=miny TO miny+1 o1& = y*320&: o2& = o1& + x2 FOR o& = o1& TO o2& IF PEEK(o&) < 16 AND PEEK(o&) > 0 THEN POKE o&, ShadowKibitzColor NEXT o&,y FOR y=126 TO 127 o1& = y*320&+x2: o2& = o1&+319-x2 FOR o& = o1& TO o2& IF PEEK(o&) < 16 AND PEEK(o&) > 0 THEN POKE o&, ShadowKibitzColor NEXT o&,y 'Update comment cursor commenty = commenty - roomneeded END IF IF size = 2 THEN colour = OtherKibitzColor FOR y = 1 TO 2 IF LEFT$(comment$, LEN(names$(y))) = names$(y) THEN colour = PlayerKibitzColor NEXT ELSE colour = StatusKibitzColor END IF IF size = 2 THEN tmp = DrawText2(3,commenty+1, comment$, 0) commenty = commenty + DrawText2(2,commenty, comment$, colour) ' Special effect: The board blinks/shimmers/fades from an overexposed state STATIC gamma! IF gamma! = 0.0 THEN PLAY "MB MSt255 l20 o5co1ce l45 o5go1c o3c50" FOR gamma! = 0.1 TO 1.0 STEP 0.05 DrawSetPalette gammaColorStart, gamma! DEF SEG = VARSEG(hlt(0)) CALL ABSOLUTE(hlt) DEF SEG = &HA000 NEXT END IF ELSE tmp = DrawText1(3,commenty+1, comment$, 0) commenty = commenty + DrawText1(2,commenty, comment$, colour) - 1 END IF END SUB FUNCTION strtime$(t!) min = INT(t! / 60.0) sec = INT(t! - min*60) strtime$ = RIGHT$(RTRIM$(STR$(min+1000)),2) + ":" + RIGHT$(RTRIM$(STR$(sec+1000)),2) END SUB SUB GameWaitMove(comments$, duration AS SINGLE, colour, moveno) DIM lines$(1000), timings(1000) AS SINGLE, gone AS SINGLE, timeslot AS SINGLE numlines = 0 beginpos& = 1 'Split the comments, one line each nl$ = CHR$(10) DO nlpos& = INSTR(beginpos&, comments$, nl$) IF nlpos& = 0 THEN s$ = LTRIM$(RTRIM$(MID$(comments$, beginpos&))) IF s$ <> "" THEN numlines=numlines+1: lines$(numlines) = s$ EXIT DO END IF s$ = LTRIM$(RTRIM$(MID$(comments$, beginpos&, nlpos& - beginpos&))) IF s$ <> "" THEN numlines=numlines+1: lines$(numlines) = s$ beginpos& = nlpos& + 1 LOOP comments$ = "" 'Deallocate string 'Assign timings for each comment line timeslot = duration / numlines ' Average size of one comment's timeslot FOR y = 1 TO numlines timings(y) = (y-1) * timeslot + RND*timeslot NEXT x = 216 + (colour-1)*54 y = 0 endturn! = TIMER + duration - 0.03 beginturn! = endturn! - duration prevtimval$ = "" WHILE TIMER < endturn! y$ = INKEY$ IF y$ = "q" OR y$ = CHR$(27) OR y$ = CHR$(3) THEN ERROR 90 gone = TIMER - beginturn! IF colour <> 0 THEN timval$ = strtime$( remtime(colour) - gone ) IF timval$ <> prevtimval$ THEN prevtimval$ = timval$ DrawTextCaption x,58, "Time:", timval$, ActiveTimeColor END IF END IF endwait! = TIMER + .25 DEF SEG = VARSEG(hlt(0)) WHILE TIMER < endwait! CALL ABSOLUTE(hlt) WEND DEF SEG = &HA000 WHILE y < numlines AND timings(y) < gone y = y + 1 DrawCommentLine lines$(y), 2, moveno WEND WEND DEF SEG = VARSEG(hlt(0)) WHILE TIMER < endturn! CALL ABSOLUTE(hlt) WEND DEF SEG = &HA000 'Ensure we didn't forget to display any comment line WHILE y < numlines y = y + 1 DrawCommentLine lines$(y), 2, moveno WEND END SUB SUB LoadPortrait(bx,by, pfn$) OPEN pfn$ AS #2 LEN=1: FIELD #2, 1 AS b$ FOR y=0 TO 33 FOR x=0 TO 23 GET #2: r=ASC(b$) GET #2: g=ASC(b$) GET #2: b=ASC(b$) SetP x+bx, y+by, r*3.91764706, g*3.91764706, b*3.91764706 NEXT x,y CLOSE #2 END SUB SUB GameRun(moveid) prevx = 0 prevy = 0 prevkind = 0 commenty = FNy(20) moveno = 0 resolution$ = "" DO nodeid = move(moveid).offs drawkind = 0 duration! = 0 whosetime = 0 comments$ = "" shininess! = 0.25 WHILE nodeid > 0 value$ = SGFreadString$( node(nodeid).offs ) SELECT CASE node(nodeid).tag CASE "PB" 'set black player name DrawTextCaption 270,40, "Black:", value$, PlayerNameColor names$(2) = value$ CASE "PW" 'set white player name DrawTextCaption 216,40, "White:", value$, PlayerNameColor names$(1) = value$ 'LoadPortrait 270-30,58, "red.dat" CASE "BR" 'set black player rank DrawText 308,46, value$, 10 CASE "WR" 'set white player rank DrawText 256,46, value$, 10 CASE "RE" resolution$ = value$ CASE "AB" 'black handicap stones x = ASC(LEFT$(value$,1))-96 y = ASC(RIGHT$(value$,1))-96 DrawBoard x,y,2, 0 GamePlayStone x-1,y-1,2 CASE "AW" 'white handicap stones x = ASC(LEFT$(value$,1))-96 y = ASC(RIGHT$(value$,1))-96 DrawBoard x,y,1, 0 GamePlayStone x-1,y-1,1 CASE "B " 'black play IF value$ = "" THEN 'pass ELSE drawx = ASC(LEFT$(value$,1))-96 drawy = ASC(RIGHT$(value$,1))-96 drawkind = 2 END IF CASE "W " 'white play IF value$ = "" THEN 'pass ELSE drawx = ASC(LEFT$(value$,1))-96 drawy = ASC(RIGHT$(value$,1))-96 drawkind = 1 END IF CASE "TM" 'set time t! = VAL(value$) ' Find out how long the opening turn lasts. (And whose turn is it.) nexttime! = VAL(SGFfindTag$(move(moveid).link, "WL")) whosetime = 1 nt1! = VAL(SGFfindTag$(move(moveid).link, "BL")) IF nt1! > nexttime! THEN nexttime! = nt1!: whosetime = 2 duration! = t! - nexttime! DrawTextCaption 216,5, "Game Start", MID$("WB",whosetime,1)+" to play", 14 CASE "BL" 'time left for black t! = VAL(value$) remtime(2) = t! DrawTextCaption 216,58, "Time:", strtime$(remtime(1)), ActiveTimeColor DrawTextCaption 270,58, "Time:", strtime$(remtime(2)), PassiveTimeColor 'Find how long turn lasts nexttime! = VAL(SGFfindTag$(move(moveid).link, "WL")) IF nexttime! > 0 THEN duration! = remtime(1) - nexttime! whosetime = 1 END IF CASE "WL" 'time left for white t! = VAL(value$) remtime(1) = t! DrawTextCaption 216,58, "Time:", strtime$(remtime(1)), PassiveTimeColor DrawTextCaption 270,58, "Time:", strtime$(remtime(2)), ActiveTimeColor 'Find how long this turn lasts nexttime! = VAL(SGFfindTag$(move(moveid).link, "BL")) IF nexttime! > 0 THEN duration! = remtime(2) - nexttime! whosetime = 2 END IF CASE "C " 'set comments for this move (newline-delimited) comments$ = comments$ + value$ 'branch "( ", circle mark "CR", all other unhandled CASE "SH" shininess! = VAL(value$) ' bisqwit extension END SELECT nodeid = node(nodeid).link WEND IF drawkind > 0 THEN moveno = moveno + 1 IF whosetime = 0 THEN DrawTextCaption 216,5, "Game Over", resolution$, 12 ELSE DrawTextCaption 216,5, "Move"+STR$(moveno), MID$("WB",whosetime,1)+" to play", 14 END IF DrawBoard prevx,prevy, prevkind,0 IF drawx > 0 AND drawy > 0 THEN shinecenterx = (FNx(drawx) + FNx(drawx+1)) * 0.5 shinecentery = (FNy(drawy) + FNy(drawy+1)) * 0.5 offs = (drawy-1) * 19 + drawx-1 boardstate(offs) = drawkind ' Special effect: Bloom/shine from the spot where the stone is played radius = 3 sfx$ = "mfmlt255 l48 o2f<a>>>>>c64" FOR shine! = shininess! TO 0.10 STEP -0.03 IF shine! <= 0.3 THEN radius = 1 'IF shine! <= 0.2 THEN radius = 0 FOR y=-radius TO +radius STEP 1 FOR x=-radius TO +radius STEP 1 IF drawx+x > 0 AND drawy+y > 0 AND drawx+x <= 19 AND drawy+y <= 19 THEN cntr = x=0 AND y=0 DrawBoard drawx+x, drawy+y, boardstate((y+drawy-1)*19+(x+drawx-1)), cntr IF cntr AND sfx$ <> "" THEN PLAY sfx$ : sfx$ = "" END IF NEXT NEXT DEF SEG = VARSEG(hlt(0)) CALL ABSOLUTE(hlt) DEF SEG = &HA000 NEXT GamePlayStone drawx-1,drawy-1, drawkind DrawBoard drawx,drawy, drawkind,1 END IF prevx = drawx prevy = drawy prevkind = drawkind END IF IF duration! = 0.0 AND comments$ <> "" THEN duration! = LEN(comments$)/60 GameWaitMove comments$, duration!, whosetime, moveno moveid = move(moveid).link LOOP WHILE moveid > 0 END SUB ' 6x5 font data, originally designed by Juha Nieminen for use in Joed: DATA 4, 0, 0, 0, 0, 0,3, 64, 64, 64, 0, 64,5, 80, 80, 0, 0, 0 DATA 6, 80,248, 80,248, 80,6,112,160,112, 40,240,6,136, 16, 32, 64,136 DATA 6, 96, 96,104,144,104,3, 64, 64, 0, 0, 0,4, 32, 64, 64, 64, 32 DATA 4, 64, 32, 32, 32, 64,7, 72, 48,252, 48, 72,6, 32, 32,248, 32, 32 DATA 3, 0, 0, 0, 64,128,5, 0, 0,240, 0, 0,3, 0, 0, 0, 0, 64 DATA 6, 8, 16, 32, 64,128,6,112,152,168,200,112,4, 64,192, 64, 64,224 DATA 5, 96,144, 32, 64,240,5,240, 16, 96, 16,224,5, 80,144,240, 16, 16 DATA 5,240,128,224, 16,224,5, 96,128,224,144, 96,5,240, 16, 32, 32, 64 DATA 5, 96,144, 96,144, 96,5, 96,144,112, 16, 96,3, 0, 64, 0, 64, 0 DATA 3, 0, 64, 0, 64,128,4, 32, 64,128, 64, 32,4, 0,224, 0,224, 0 DATA 4,128, 64, 32, 64,128,5, 96,144, 32, 0, 32,5, 96,144,176,128, 96 DATA 5, 96,144,240,144,144,5,224,144,224,144,224,5,112,128,128,128,112: REM ABC DATA 5,224,144,144,144,224,5,240,128,224,128,240,5,240,128,224,128,128: REM DEF DATA 5,112,128,176,144,112,5,144,144,240,144,144,4,224, 64, 64, 64,224: REM GHI DATA 5, 16, 16, 16,144, 96,5,144,160,192,160,144,5,128,128,128,128,240: REM JKL DATA 6,136,216,168,136,136,6,136,200,168,152,136,5, 96,144,144,144, 96: REM MNO DATA 5,224,144,224,128,128,5, 96,144,144,176,112,5,224,144,224,160,144: REM PQR DATA 5, 96,128, 96, 16,224,6,248, 32, 32, 32, 32,5,144,144,144,144, 96: REM STU DATA 6,136,136, 80, 80, 32,6,136,136,136,168, 80,6,136, 80, 32, 80,136: REM VWX DATA 6,136, 80, 32, 32, 32,6,248, 16, 32, 64,248,3,192,128,128,128,192: REM YZ[ DATA 6,128, 64, 32, 16, 8,3,192, 64, 64, 64,192,4, 64,160, 0, 0, 0: REM \]^ DATA 5, 0, 0, 0, 0,240,3,128, 64, 0, 0, 0,5, 96, 16,112,144,112: REM _`a DATA 5,128,128,224,144,224,4, 0, 96,128,128, 96,5, 16, 16,112,144,112: REM bcd DATA 5, 0, 96,240,128, 96,4, 96,128,192,128,128,4, 0, 96,160, 96,192: REM efg DATA 5,128,128,224,144,144,4, 64, 0,192, 64,224,3, 64, 0, 64, 64,192: REM hij DATA 5,128,160,192,160,144,4,192, 64, 64, 64,224,6, 0,208,168,168,136: REM klm DATA 5, 0,224,144,144,144,5, 0, 96,144,144, 96,5, 0,224,144,224,128: REM nop DATA 5, 0,112,144,112, 16,4, 0, 96,128,128,128,5, 0,112,192, 48,224: REM qrs DATA 4, 64,224, 64, 64, 32,5, 0,144,144,144,112,6, 0,136,136, 80, 32: REM tuv DATA 6, 0,136,136,168, 80,5, 0,144, 96, 96,144,5, 0,144,112, 16, 96: REM wxy DATA 5, 0,240, 32, 64,240,4, 96, 64,128, 64, 96,3, 64, 64, 64, 64, 64: REM z{| DATA 4,192, 64, 32, 64,192,5, 80,160, 0, 0, 0: REM }~ ' 6x7 font data, copied from FCEUX, edited to make more regular DATA 6, 0, 0, 0, 0, 0, 0, 0, 3, 64, 64, 64, 64, 64, 0, 64 DATA 5, 80, 80, 80, 0, 0, 0, 0, 6, 80, 80,248, 80,248, 80, 80 DATA 6, 32,120,160,112, 40,240, 32, 6, 64,168, 80, 32, 80,168, 16 DATA 6, 96,144,160, 64,168,144,104, 3, 64, 64, 0, 0, 0, 0, 0 DATA 4, 32, 64, 64, 64, 64, 64, 32, 4, 64, 32, 32, 32, 32, 32, 64 DATA 6, 0, 80, 32,248, 32, 80, 0, 6, 0, 32, 32,248, 32, 32, 0 DATA 3, 0, 0, 0, 0, 0, 64,128, 5, 0, 0, 0,240, 0, 0, 0 DATA 3, 0, 0, 0, 0, 0, 0, 64, 5, 16, 16, 32, 32, 32, 64, 64 DATA 6,112,136,136,136,136,136,112, 6, 32, 96, 32, 32, 32, 32, 32: REM 0 DATA 6,112,136, 8, 48, 64,128,248, 6,112,136, 8, 48, 8,136,112 DATA 6, 16, 48, 80,144,248, 16, 16, 6,248,128,128,240, 8, 8,240 DATA 6, 48, 64,128,240,136,136,112, 6,248, 8, 16, 16, 32, 32, 32 DATA 6,112,136,136,112,136,136,112, 6,112,136,136,120, 8, 16, 96 DATA 3, 0, 0, 64, 0, 0, 64, 0, 3, 0, 0, 64, 0, 0, 64,128 DATA 4, 0, 32, 64,128, 64, 32, 0, 5, 0, 0,240, 0,240, 0, 0 DATA 4, 0,128, 64, 32, 64,128, 0, 5,112,136, 8, 16, 32, 0, 32 DATA 6,112,136,136,184,176,128,112 DATA 6,112,136,136,248,136,136,136, 6,240,136,136,240,136,136,240: REM A DATA 6,112,136,128,128,128,136,112, 6,224,144,136,136,136,144,224: REM C DATA 6,248,128,128,240,128,128,248, 6,248,128,128,240,128,128,128: REM E DATA 6,112,136,128,184,136,136,120, 6,136,136,136,248,136,136,136: REM G DATA 4,224, 64, 64, 64, 64, 64,224, 6, 8, 8, 8, 8, 8,136,112: REM I DATA 6,136,144,160,192,160,144,136, 6,128,128,128,128,128,128,248: REM K DATA 6,136,216,168,168,136,136,136, 6,136,136,200,168,152,136,136: REM M DATA 7, 48, 72,132,132,132, 72, 48, 6,240,136,136,240,128,128,128: REM P DATA 6,112,136,136,136,168,144,104, 6,240,136,136,240,144,136,136: REM R DATA 6,112,136,128,112, 8,136,112, 6,248, 32, 32, 32, 32, 32, 32: REM T DATA 6,136,136,136,136,136,136,112, 6,136,136,136, 80, 80, 32, 32: REM V DATA 6,136,136,136,136,168,168, 80, 6,136,136, 80, 32, 80,136,136: REM X DATA 6,136,136, 80, 32, 32, 32, 32, 6,248, 8, 16, 32, 64,128,248: REM Z DATA 3,192,128,128,128,128,128,192, 5, 64, 64, 32, 32, 32, 16, 16: REM \ DATA 3,192, 64, 64, 64, 64, 64,192, 4, 64,160, 0, 0, 0, 0, 0: REM ` DATA 6, 0, 0, 0, 0, 0, 0,248, 3,128, 64, 0, 0, 0, 0, 0 DATA 5, 0, 0, 96, 16,112,144,112, 5,128,128,224,144,144,144,224: REM a DATA 5, 0, 0,112,128,128,128,112, 5, 16, 16,112,144,144,144,112: REM c DATA 5, 0, 0, 96,144,240,128,112, 5, 48, 64,224, 64, 64, 64, 64: REM e DATA 5, 0, 0,112,144,112, 16,224, 5,128,128,224,144,144,144,144: REM g DATA 2,128, 0,128,128,128,128,128, 4, 32, 0, 32, 32, 32, 32,192: REM i DATA 5,128,128,144,160,192,160,144, 2,128,128,128,128,128,128,128: REM k DATA 6, 0, 0,208,168,168,168,168, 5, 0, 0,224,144,144,144,144: REM m DATA 5, 0, 0, 96,144,144,144, 96, 5, 0, 0,224,144,144,224,128: REM p DATA 5, 0, 0,112,144,144,112, 16, 5, 0, 0,176,192,128,128,128: REM r DATA 5, 0, 0,112,128, 96, 16,224, 4, 64, 64,224, 64, 64, 64, 32: REM t DATA 5, 0, 0,144,144,144,144,112, 5, 0, 0,144,144,144,160,192: REM v DATA 6, 0, 0,136,136,168,168, 80, 5, 0, 0,144,144, 96,144,144: REM x DATA 5, 0, 0,144,144,112, 16, 96, 5, 0, 0,240, 32, 64,128,240: REM z DATA 4, 32, 64, 64,128, 64, 64, 32, 3, 64, 64, 64, 64, 64, 64, 64: REM | DATA 4,128, 64, 64, 32, 64, 64,128, 6, 0,104,176, 0, 0, 0, 0: REM ~ |